lib/CXGN/Tools/WebImageCache.pm

   1
   2 =head1 NAME
   3
   4 CXGN::Tools::WebImageCache - manages a local cache of images that are
   5 generated on the fly from data
   6
   7 =head1 SYNOPSYS
   8
   9  my $cache = CXGN::Tools::WebImageCache->new();
  10  $cache->set_key("abc");
  11  $cache->set_expiration_time(86400); # seconds, this would be a day.
  12  $cache->set_map_name("map_name"); # what's in the <map name='map_name' tag.
  13  $cache->set_temp_dir("/documents/tempfiles/cview");
  14  $cache->set_basedir("/data/local/website/"); # would get this from VHost...
  15  if (! $cache->is_valid()) {
  16     # generate the image and associated image map.
  17     # ...
  18     $img_data = ...
  19     $img_map_data = ...
  20     $cache->set_image_data($img_data);
  21     $cache->set_image_map_data($image_map_data);
  22  }
  23  print $cache->get_image_html();
  24
  25 =head1 DESCRIPTION
  26
  27
  28 =head1 AUTHOR(S)
  29
  30  Lukas Mueller <lam87@cornell.edu>
  31
  32 =head1 METHODS
  33
  34 This class implements the following methods:
  35
  36 =cut
  37
  38 use strict;
  39 use warnings;
  40
  41 package CXGN::Tools::WebImageCache;
  42
  43 use base "CXGN::Debug";
  44
  45 use File::Path ();
  46 use File::Basename ();
  47 use Digest::MD5;
  48
  49 =head2 new
  50
  51   Synopsis:     $wic = CXGN::Tools::WebImageCache->new(
  52                        { expiration_time => 80000,
  53                          key             => 'blabla',
  54                          temp_dir        => $tempdir,
  55                          base_dir        => $basedir,
  56                                                       });
  57   Arguments:
  58   Returns:
  59   Side effects:
  60   Description:
  61
  62 =cut
  63
  64 sub new {
  65     my $class = shift;
  66     my $args = shift;
  67     my $self = bless {}, $class;
  68     $self->set_expiration_time($args->{expiration_time})
  69         if exists($args->{expiration_time});
  70
  71     $self->set_cache_name($args->{filename})
  72         if exists($args->{filename});
  73
  74     $self->set_key($args->{key})
  75         if exists($args->{key});
  76
  77     $self->set_temp_dir($args->{temp_dir})
  78         if exists($args->{temp_dir});
  79
  80     $self->set_basedir($args->{basedir})
  81         if exists($args->{basedir});
  82
  83     $self->set_force($args->{force})
  84         if exists($args->{force});
  85
  86     $self->set_function($args->{function})
  87         if exists($args->{function});
  88
  89     $self->set_image_type($args->{image_type})
  90         if exists($args->{image_type});
  91
  92     return $self;
  93 }
  94
  95 =head2 accessors set_temp_dir, get_temp_dir
  96
  97   Property:     the tempfile directory, excluding the basepath
  98   Side Effects:
  99   Description:
 100
 101 =cut
 102
 103 sub get_temp_dir {
 104     my $self=shift;
 105     return $self->{temp_dir};
 106
 107 }
 108
 109 sub set_temp_dir {
 110     my $self=shift;
 111     $self->{temp_dir}=shift;
 112 }
 113
 114 =head2 accessors set_basedir, get_basedir
 115
 116   Property:     the basepath. Forms the fully qualified path if
 117                 temp_dir is appended to it.
 118   Side Effects:
 119   Description:
 120
 121 =cut
 122
 123 sub get_basedir {
 124     my $self=shift;
 125     return $self->{basedir};
 126 }
 127
 128 sub set_basedir {
 129     my $self=shift;
 130     $self->{basedir}=shift;
 131 }
 132
 133 =head2 function get_file_url
 134
 135   Synopsis:     returns the url of the tempfile
 136   Side effects:
 137   Description:
 138
 139 =cut
 140
 141 sub get_file_url {
 142     my $self = shift;
 143     return File::Spec->catfile($self->get_temp_dir(), $self->get_cache_name());
 144 }
 145
 146 =head2 function get_filepath
 147
 148   Synopsis:     returns the path of the temp file
 149   Side effects:
 150   Description:
 151
 152 =cut
 153
 154 sub get_filepath {
 155     my $self = shift;
 156     return File::Spec->catfile($self->get_basedir(), $self->get_temp_dir(), $self->get_cache_name());
 157 }
 158
 159 =head2 function get_image_path
 160
 161   Description:  returns the fully qualified path to the image.
 162
 163 =cut
 164
 165 sub get_image_path {
 166     my $self = shift;
 167     return $self->get_filepath().".".$self->get_image_type();
 168 }
 169
 170 =head2 function get_image_url
 171
 172   Description:  returns the url of the cache image
 173
 174 =cut
 175
 176 sub get_image_url {
 177     my $self = shift;
 178     $self->get_file_url().".".$self->get_image_type();
 179 }
 180
 181 =head2 function get_image_map_path
 182
 183   Description:  returns the fully qualified path to the file
 184
 185 =cut
 186
 187 sub get_image_map_path {
 188     my $self = shift;
 189     return $self->get_filepath().".map";
 190 }
 191
 192 =head2 accessors set_expiration_time, get_expiration_time
 193
 194   Property:     the time in seconds after which the cache is considered
 195                 obsolete
 196   Args/Rets:    the number of seconds that specify the expiration time
 197   Side Effects: the cache will be considered invalid after this number
 198                 of seconds have elapsed, and is_valid() will return
 199                 false, even if the cache file exists.
 200                 If no expiration time is set, the cached file will never
 201                 expire.
 202   Description:
 203
 204 =cut
 205
 206 sub get_expiration_time {
 207     my $self=shift;
 208     return $self->{expiration_time};
 209 }
 210
 211 sub set_expiration_time {
 212     my $self=shift;
 213         my $expiration_time = shift;
 214         unless($expiration_time =~ /^\d+$/){
 215                 $expiration_time = 60 if $expiration_time =~ /minute/i;
 216                 $expiration_time = 3600 if $expiration_time =~ /hour/i;
 217                 $expiration_time = 3600*24 if $expiration_time =~ /day/i;
 218                 $expiration_time = 3600*24*7 if $expiration_time =~ /week/i;
 219                 $expiration_time = 3600*24*30 if $expiration_time =~ /month/i;
 220                 $expiration_time = 3600*24*365 if $expiration_time =~ /year/i;
 221         }
 222     $self->{expiration_time} = $expiration_time;
 223 }
 224
 225 =head2 accessors set_key, get_key
 226
 227   Property:     the unique key that identifies the web image,
 228                 such as a concatenation of parameters that are
 229                 used to generate the image in a webpage.
 230                 This property needs to be set, otherwise the
 231                 program dies.
 232   Side Effects:
 233   Description:
 234
 235 =cut
 236
 237 sub get_key {
 238     my $self=shift;
 239     if (!exists($self->{key})) { die "use set_key to set a key. cannot proceed.\n"; }
 240     return $self->{key};
 241 }
 242
 243 sub set_key {
 244     my $self=shift;
 245     $self->{key}=shift;
 246 }
 247
 248 =head2 accessors set_cache_name, get_cache_name
 249
 250   Property:     the name of the cache file. An md5checksum of the
 251                 key is the default. Should probably not be changed...
 252   Side Effects:
 253   Description:
 254
 255 =cut
 256
 257 sub get_cache_name {
 258     my $self=shift;
 259     return $self->{cache_name};
 260 }
 261
 262 sub set_cache_name {
 263     my $self=shift;
 264     $self->{cache_name}=shift;
 265 }
 266
 267 =head2 accessors set_image_data, get_image_data
 268
 269   Property:     image data, as a string
 270   Args/Ret:     the image data, as a string.
 271   Side Effects: writes the string to the cache image file.
 272   Description:
 273
 274 =cut
 275
 276 sub get_image_data {
 277     my $self=shift;
 278     open (my $FILE, "<", $self->get_image_path()) || die "Can't open ".$self->get_image_path()." for reading";
 279     my @contents = <$FILE>;
 280     close($FILE);
 281     return join "\n", @contents;
 282 }
 283
 284 sub set_image_data {
 285     my $self=shift;
 286     my @contents = @_;
 287
 288     $self->d("Generating image cache file ".$self->get_image_path()."\n");
 289
 290     my $dir = File::Basename::dirname( $self->get_image_path );
 291     File::Path::mkpath($dir);
 292     open (my $FILE, ">", $self->get_image_path()) || die "Can't open ".$self->get_image_path()." for writing";
 293     print $FILE join "\n", @contents;
 294     close($FILE);
 295 }
 296
 297 =head2 accessors set_image_map_data, get_image_map_data
 298
 299   Property:     the image map data as a string
 300   Side Effects: writes/retrieves the image map data to/from
 301                 the cache file.
 302   Description:
 303
 304 =cut
 305
 306 sub get_image_map_data {
 307     my $self=shift;
 308     $self->d("Generating image map cache file ".$self->get_image_map_path()."\n");
 309     open (my $FILE, "<".($self->get_image_map_path())) || die "Can't open ".$self->get_image_map_path();
 310     my @contents = <$FILE>;
 311     close($FILE);
 312     return join "\n", @contents;
 313
 314 }
 315
 316 sub set_image_map_data {
 317     my $self=shift;
 318     my @contents = @_;
 319     open (my $FILE, ">".($self->get_image_map_path())) || die "Can't open ".$self->get_image_map_path();
 320     print $FILE join "\n", @contents;
 321     close($FILE);
 322
 323 }
 324
 325 =head2 function is_valid
 326
 327   Synopsis:     $wic->is_valid()
 328   Arguments:    none
 329   Returns:      true if the cache is valid, false if not
 330   Side effects:
 331   Description:  the cache may be valid because it was not
 332                 initialized, or because the time expiration has
 333                 occurred, or because the cache's force parameter
 334                 has been set.
 335
 336 =cut
 337
 338 sub is_valid {
 339     my $self = shift;
 340
 341     # generate the filename from the key
 342     $self->_hash();
 343
 344     if ($self->get_force() eq "1") {
 345         $self->d("Force reloading cache...\n");
 346         return 0;
 347     }
 348
 349     # is there a cache file?
 350     if (-e $self->get_image_path()) {
 351
 352         # has the expiration time already expired?
 353         if ($self->get_expiration_time()) {
 354
 355             my $mtime = (stat($self->get_image_path()))[9];
 356             my $age = time()-$mtime;
 357             if ($age > $self->get_expiration_time()) {
 358                 $self->d("ARGH! Cache has expired!!!!!\n");
 359                 return 0;
 360             }
 361         }
 362
 363         # the cache file is ok.
 364         $self->d("Cache exists...\n");
 365         return 1;
 366     }
 367     else {
 368         # there is no cache.
 369         $self->d("Cache DOES NOT exist!\n");
 370         return 0;
 371     }
 372 }
 373
 374 =head2 function get_image_tag
 375
 376   Synopsis:     my $img_tag = $wic -> get_image_tag();
 377   Arguments:    none
 378   Returns:      the html for the cached image.
 379   Side effects:
 380   Description:
 381
 382 =cut
 383
 384 sub get_image_tag {
 385     my $self= shift;
 386     my $image_url = $self->get_image_url();
 387     my $usemap = $self->get_map_name();
 388     no warnings 'uninitialized';
 389     return qq{ <img src="$image_url" border="0" usemap="#$usemap" />\n };
 390 }
 391
 392 =head2 accessors set_map_name, get_map_name
 393
 394   Property:     the name of the image map, to link to the image with usemap.
 395   Side Effects:
 396   Description:
 397
 398 =cut
 399
 400 sub get_map_name {
 401 my $self=shift;
 402 return $self->{map_name};
 403 }
 404
 405 sub set_map_name {
 406     my $self=shift;
 407     $self->{map_name}=shift;
 408 }
 409
 410 =head2 accessors set_force, get_force
 411
 412   Property:     force - whether to force the generation of
 413                 a new image
 414   Setter Args:  true to force generation of new file
 415                 false to use cache if present
 416   Getter Args:  none
 417   Side Effects: true value will cause old file to be deleted
 418   Description:
 419
 420 =cut
 421
 422 sub get_force {
 423     my $self=shift;
 424     if (!exists($self->{force}) || !defined($self->{force})) {
 425         $self->{force} = 0;
 426     }
 427     return $self->{force};
 428 }
 429
 430 sub set_force {
 431     my $self=shift;
 432     $self->{force}=shift;
 433 }
 434
 435 =head2 function get_image_html
 436
 437   Synopsis:     $image->get_image_html()
 438   Arguments:    none
 439   Returns:      a string representing the image in html,
 440                 including the image tag and the image map.
 441   Side effects:
 442   Description:
 443
 444 =cut
 445
 446 sub get_image_html {
 447     my $self = shift;
 448         my $map_data = undef;
 449         eval{$map_data = $self->get_image_map_data()};
 450         $map_data = "" if $@;
 451     return $self->get_image_tag() ."<br />". $map_data;
 452 }
 453
 454 =head2 accessors set_function, get_function
 455
 456   Property:     (Don't know what that is? Who added this function?)
 457   Setter Args:
 458   Getter Args:
 459   Getter Ret:
 460   Side Effects:
 461   Description:
 462
 463 =cut
 464
 465 sub get_function {
 466     my $self=shift;
 467     return $self->{function};
 468 }
 469
 470 sub set_function {
 471     my $self=shift;
 472     $self->{function}=shift;
 473 }
 474
 475 =head2 accessors set_image_type, get_image_type
 476
 477   Property:     the type of image to be handled.
 478   Args/Ret:     the image type, such as png, jpg, etc.
 479   Side Effects: used to construct the cache image name
 480   Description:  default returned is "png"
 481
 482 =cut
 483
 484 sub get_image_type {
 485     my $self=shift;
 486     if (!exists($self->{image_type}) || !defined($self->{image_type})) {
 487         $self->{image_type}="png";
 488     }
 489     return $self->{image_type};
 490 }
 491
 492 sub set_image_type {
 493     my $self=shift;
 494     $self->{image_type}=shift;
 495 }
 496
 497 =head2 function _hash
 498
 499   Synopsis:
 500   Arguments:
 501   Returns:
 502   Side effects:
 503   Description:
 504
 505 =cut
 506
 507 sub _hash {
 508     my $self = shift;
 509     my $filename = Digest::MD5->new()->add($self->get_key())->hexdigest();
 510     $self->d("Generated filename $filename\n");
 511     $self->set_cache_name($filename);
 512 }
 513
 514 =head2 destroy
 515
 516  Usage:
 517  Desc:
 518  Ret:
 519  Args:
 520  Side Effects:
 521  Example:
 522
 523 =cut
 524
 525 sub destroy {
 526     my $self = shift;
 527     return unlink($self->get_image_path(), $self->get_image_map_path());
 528 }
 529
 530
 531
 532 1;