view release on metacpan or  search on metacpan

Album.pm  view on Meta::CPAN

      my ($max_width, $max_height) = ($1, $2);

      if (-f "$album_dir/$check_dir/$check_filename") {
#	$r->log_error("\$album_uri: $album_uri \$thumb_uri: $thumb_uri");
	return &show_picture($r, $album_uri, $thumb_uri, 
                             "$check_dir/$check_filename",
			     \%settings, $max_width, $max_height);
      }
    }
  }
  
  # We have a directory, but does $path_info end in a
  # / like all good directories should?  If not, add
  # it and do a redirect, makes the pictures show up
  # easier later.
  unless ( $r->path_info =~ m!/$!) {
    $r->server->warn("Redirecting -> " . $r->uri . "/");
    $r->headers_out->{'Location'} = $r->uri . "/";
    return Apache2::Const::REDIRECT;
  }

  # Try to open the directory, and read all the image file
  # that aren't thumbnails
  unless(opendir(IN,"$album_dir/$path_info")) {
    $r->log_error("Couldn't open $album_dir/$path_info: $!");
    return Apache2::Const::SERVER_ERROR;
  }

  my @files = grep { !/\.htaccess/ && !/^tn__/
		       && $r->lookup_uri("$album_uri/$_")->content_type =~ 
		       m!^image/!} readdir(IN);
  closedir(IN);

  # If we have a directory, but slide_show is set, we need to grab the
  # first file and redirect
  if (defined $params{'slide_show'}) {
    @files = sort(@files);
    $r->server->warn("Redirecting -> " . $r->uri . $files[0] . "?slide_show="
	     . $params{'slide_show'});
    $r->headers_out->{'Location'} = $r->uri . $files[0] . "?slide_show="
	     . $params{'slide_show'};
    return Apache2::Const::REDIRECT;
  }

  # if @files is empty, need to call show_albums
  return &show_albums($r, "$album_dir/$path_info", $path_info, \%settings)
    unless @files;

  @files = sort @files;
  @files = reverse @files
    if $settings{'ReversePics'};

  my @cleanup_subs = ();

  # Load up thumbnails
  # Unless the thumbnail file exists, and
  # is newer than the file it's a thumbnail for, generate the
  # thumbnail
  foreach (@files) {
    unless ( -e "$thumb_dir/$path_info/tn__$_" && 
	     (stat(_))[9] > (stat("$album_dir/$path_info/$_"))[9] ) {

      # Make sure the thumbnail directory exists
      &mymkdir("$thumb_dir/$path_info", 0755) 
	unless -d "$thumb_dir/$path_info";

      # Create a new thumbnail
      my $q = new Image::Magick;
      unless ($q) {
	$r->log_error("Couldn't create a new Image::Magick object");
	return Apache2::Const::SERVER_ERROR;
      }
     
      # Setting the size before reading the image is dramatically
      # faster.  The trade-off is that the quality of the resized
      # image will be lower, which is OK for thumbnails.
      # The actual resize (below) could be done with ->Sample() for
      # similar reasons, but some limited testing revealed that the
      # cumulative benefit of setting the size and using Sample was
      # almost non-existant.  Using ->Scale() instead might have a
      # small quality benefit.

      # Load up the current images width and height
      my ($o_width, $o_height) = $q->Ping("$album_dir/$path_info/$_");
      my ($ratio, $t_width, $t_height, $t_aspect);

      # If we're using aspect, then multiply width and
      # height by the aspect ratio
      if ( $settings{'ThumbNailUse'} eq "aspect") {
	$t_aspect = $settings{'ThumbNailAspect'};
	# get the *real* aspect
	$t_aspect =~ tr[^0-9/.][];
	$t_aspect = eval($t_aspect);
	$t_width  = $o_width  * $t_aspect;
	$t_height = $o_height * $t_aspect;
      }
      else {
	# Otherwise just make the width a constant and
	# keep the same aspect ratio for the height
	$t_width =  $settings{'ThumbNailWidth'};
	$ratio = $o_width / $o_height if $o_height;
	$t_height = $t_width / $ratio if $ratio;
      }

      $q->Set( size => "${t_width}x${t_height}" );

      $q->Read("$album_dir/$path_info/$_");

      # Scale it down, and save the file
      $q->Scale( width => $t_width, height => $t_height );
      $q->Write("$thumb_dir/$path_info/tn__$_");

      undef $q;

      # Create smaller versions of the full size image if requested
      if ($settings{'AllowFinalResize'}) {
	my $q = new Image::Magick;
	unless ($q) {
	  $r->log_error("Couldn't create a new Image::Magick object");
	  return Apache2::Const::SERVER_ERROR;
	}