PUT results from the CPAN

Apache-Album

view release on metacpan or search on metacpan


  $r->print("</TR></TABLE></CENTER>\n");
  if ($settings{'EditMode'}) {
    $r->print(&file_upload());
  }
  $r->print("<hr>\n$settings{'Footer'}\n<hr>") if $settings{'Footer'};
  $r->print(<<EOF);
</BODY>
</HTML>
EOF

    return Apache2::Const::OK;
}

# show_albums simply shows the albums under the directory
# it should probably not be called, a "real" web page with
# links to the albums would probably be better, but this
# helps when debugging, or if someone decides to go to this
# directory directly
sub show_albums {
  my ($r, $album_dir, $path_info, $settings) = @_;

  unless ($r->uri =~ m|/$|) {
    $r->log_error("Redirecting -> " . $r->uri . "/");
    $r->headers_out->{Location} = $r->uri . "/";
    return Apache2::Const::REDIRECT;
  }

  unless (opendir(IN,$album_dir)) {
    $r->log_error("Could not open $album_dir: $!");
    return Apache2::Const::SERVER_ERROR;
  }
  
  my @dirs = grep { -d "$album_dir/$_" && ! /^\./ } readdir(IN);
  closedir(IN);

  $r->content_type('text/html');
  #$r->send_http_header();
  return Apache2::Const::OK if $r->header_only;

  $r->print(<<EOF);
<HTML><HEADER><TITLE>$$settings{AlbumTitle}</TITLE></HEADER>
<BODY $$settings{'BodyArgs'}>
<H3>$$settings{AlbumTitle}</H3>
EOF

  $r->print($path_info)
    if $path_info;

  @dirs = sort @dirs;
  @dirs = reverse @dirs
    if $settings->{'ReverseDirs'};
  
  foreach (@dirs) {
    $r->print("\n<dl>\n");
    &list_dirs($r, $album_dir, $_, "", $settings );
    $r->print("\n</dl>\n");
  }

  if ($settings->{'EditMode'}) {
    $r->print(qq!<FORM METHOD="POST">New Album:<INPUT TYPE="text" NAME="AlbumName"><INPUT TYPE="submit" NAME="New Album" VALUE="New Album"></FORM>!);

    unless (@dirs) {
      $r->print(&file_upload());
    }
  }


  $r->print(<<EOF);
<HR>
<address>Apache::Album</address>
</BODY>
</HTML>
EOF
  return Apache2::Const::OK;  
}

# parseArgs is used to turn the array of arguments
# into a nice hash.  This is fairly lame as I'm not
# expecting to get any duplicate values
sub parseArgs {
  my $r = shift;
  my @args = @_;
  my %params = ();

  foreach (@args) {
    /(.*)=(.*)/;
    my ($key,$val) = ($1, $2);
    $params{$key} = $val;
  }

  return %params;
}

# Show picture shows the actual full sized picture,
# I might add some cool things like filters and 
# such since we use ImageMagick for the thumbnails
# For now, just show the picture and a caption
sub show_picture {
  my ($r, $album_uri, $thumb_uri, $path_info, $settings) = @_[0..4];
  my $album_dir = $r->lookup_uri($album_uri)->filename;
  my $thumb_dir = $r->lookup_uri($thumb_uri)->filename;
  
  my $caption = $path_info;

  my $modified_path_info = "$album_uri/$path_info";
  my $start_link = "";
  my $end_link = "";
  my @slideShow;
  my($prevSeven, $nextSeven);

  $caption =~ s!.*/!!;
  $caption =~ s!\.[^.]*$!!;
  $caption =~ tr[-_][  ];

  my $title = $caption;

  $caption = qq!<H3>$caption</H3>!;

  my ($path_dir,$path_file) = $path_info =~ m!(.*)/(.*)!;

Album.pm view on Meta::CPAN

  my @dirs = ();

  if (opendir(IN, "$album_dir/$directory")) {
    @dirs = grep { -d "$album_dir/$directory/$_" 
		     && ! /^\./
		   } readdir(IN);
    closedir(IN);
  }
  else {
    $r->log_error("Could not open $album_dir/$directory: $!");
  }

  @dirs = sort @dirs;

  if (-f "$album_dir/$directory/.htaccess") {
    my $override = 0;

    # check if ReverseDirs is specified in here
    if (open (IN, "$album_dir/$directory/.htaccess")) {
      while (<IN>) {
	if (/ReverseDirs\s+(.*)$/) {
	  @dirs = reverse @dirs
	    if $1;
	  $override = 1;
	}
      }
      close IN;

      unless ($override) {
	@dirs = reverse @dirs
	  if $settings->{'ReverseDirs'};
      }
      
    }
    else {
      @dirs = reverse @dirs
	if $settings->{'ReverseDirs'};
    }
  }
  else {
    @dirs = reverse @dirs
      if $settings->{'ReverseDirs'};
  }
  
  if (@dirs) {
    $r->print("\t<dd><dl>\n");
    foreach (@dirs) {
      &list_dirs($r, "$album_dir/$directory", $_, "$old_directory$directory/", $settings);
    }
    $r->print("\t</dl></dd>\n");
  }
}

# file_upload is just the html for the file upload
# it's in a sub since it will be called from multiple 
# places
sub file_upload {

  my $ret = <<EOF
<FORM METHOD="POST" ENCTYPE="multipart/form-data">
  <INPUT TYPE="submit" NAME="Upload" VALUE="Upload">
  <INPUT TYPE="file" NAME="filename" SIZE=50 MAXLENGTH=200>
</FORM>
EOF
  ;

  return $ret;
}

sub create_final_resize {
  my ($r, $settings, $album_dir, $thumb_dir, $path_info, $filename, $o_width, $o_height) = @_;

  my $q = new Image::Magick;
  $q->Read("$album_dir/$path_info/$filename");

  my $ratio = $o_width / $o_height if $o_height;

  # X-Large is 1600x1200
  if ($o_width > 1600) {
    my $f_height = 0;
    $f_height = 1600 / $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 => 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/"

( run in 1.899 second using v1.01-cache-2.11-cpan-140bd7fdf52 )