view release on metacpan or  search on metacpan

Album.pm  view on Meta::CPAN

    unless ($q) {
      $r->log_error("Couldn't create a new Image::Magick object");
      return Apache2::Const::SERVER_ERROR;
    }
    
    $q->Scale( width => 1600, height => $f_height );
    $q->Write("$thumb_dir/$path_info/"
	      . "/1600x1200_$filename");
  }
  
  # Large is 1024x768
  if ($o_width > 1024) {
    my $f_height = 0;
    $f_height = 1024 / $ratio if $ratio;
    
    my $q = $q->Clone();
    unless ($q) {
      $r->log_error("Couldn't create a new Image::Magick object");
      return Apache2::Const::SERVER_ERROR;
    }
    
    $q->Scale( width => 1024, height => $f_height );
    $q->Write("$thumb_dir/$path_info/"
	      . "/1024x768_$filename");
  }
  
  # Med is 800x600
  if ($o_width > 800) {
    my $f_height = 0;
    $f_height = 800 / $ratio if $ratio;
    
    my $q = $q->Clone();
    unless ($q) {
      $r->log_error("Couldn't create a new Image::Magick object");
      return Apache2::Const::SERVER_ERROR;
    }
    
    $q->Scale( width => 800, height => $f_height );
    $q->Write("$thumb_dir/$path_info/"
	      . "/800x600_$filename");
  }
  
  # Sm is 640x480
  if ($o_width > 640) {
    my $f_height = 0;
    $f_height = 640 / $ratio if $ratio;
    
    my $q = $q->Clone();
    unless ($q) {
      $r->log_error("Couldn't create a new Image::Magick object");
      return  Apache2::Const::SERVER_ERROR;
    }
    
    $q->Scale( width => 640, height => $f_height );
    $q->Write("$thumb_dir/$path_info/"
	      . "/640x480_$filename");
  }
  
}

sub update_settings {
  my ($r, $settings, $album_dir, $path_info) = @_;
  my $current_path = "$album_dir/";
  foreach my $next_dir (split(m|/|, $path_info)) {
    $current_path .= "$next_dir/";

    # check to see if there is an .htaccess file there, if so
    # parse it looking for PerlSetVar's that override the defaults/
    # httpd.conf files
    if ( -f "$current_path/.htaccess") {
      if (open (IN,"$current_path/.htaccess")) {
	while (<IN>) {
	  next if /^\s*$/;
	  next if /^\#/;
	  if (/^PerlSetVar\s+(\w+)\s+(.*)$/) {
	    my ($key,$value) = ($1,$2);
	    $settings->{$key} = $value;
	  }
	}
	close IN;
      }
      else {
	$r->log_error("Couldn't open $current_path/.htaccess: $!");
      }
    }
  }
}

sub mymkdir {
  my ($dir, $mode) = @_;
  my @dir = split('/', $dir);
  my $curDir = "";

  foreach (@dir) {
    next unless $_;
    $curDir .= "/$_";

    mkdir($curDir, $mode)
      unless (-d $curDir);
  }
}
      


1;
__END__

=head1 NAME

Apache::Album - Simple mod_perl Photo Album

=head1 SYNOPSIS

Add to httpd.conf

 <Location /albums>
   SetHandler perl-script
   PerlHandler Apache::Album
#   PerlSetVar  AlbumDir            /albums_loc
#   PerlSetVar  ThumbNailUse        Width  
#   PerlSetVar  ThumbNailWidth      100