origin results from the CPAN

Album

    open(my $out, ">".$css) or die("$css: $!\n");
    binmode($out);
    print {$out} ($data);
    close($out) or die("$css: $!\n");
}

################ End Style Sheets ################

sub detab {
    my ($line) = @_;
    my $orig = $line;
    my (@l) = split(/\t/, $line, -1);

    # Replace tabs with blanks, retaining layout

    $line = shift(@l);
    $line .= " " x (8-length($line)%8) . shift(@l) while @l;

    $line;
}

################ Copying: plain files ################

sub copy {
    my ($orig, $new, $time) = @_;

    $time = (stat($orig))[9] unless defined($time);

    my $in = do { local *F; *F };
    open($in, "<", $orig) or die("$orig: $!\n");
    binmode($in);

    my $out = do { local *F; *F };
    open($out, ">", $new) or die("$new: $!\n");
    binmode($out);

    my $buf;

    for (;;) {
	my ($r, $w, $t);
	defined($r = sysread($in, $buf, 10240))
	  or die("$orig: $!\n");
	last unless $r;
	for ( $w = 0; $w < $r; $w += $t ) {
	    $t = syswrite($out, $buf, $r - $w, $w)
	      or die("$new: $!\n");
	}
    }
    close($in);
    close($out) or die("$new: $!\n");
    utime($time, $time, $new);
}

################ Copying: MPG files ################

sub copy_mpg {
    my ($orig, $new, $time, $rotate, $mirror) = @_;
    $time = (stat($orig))[9] unless defined($time);

    # I'm not sure what this does. The resultant file is about 10% of
    # the original, without missing something...
    my $cmd = "$prog_mencoder -of mpeg -oac copy -ovc ".
	($rotate ? "lavc -lavcopts vcodec=mpeg1video -vop rotate=".int($rotate/90)." " : "copy ") .
	  squote($orig) . " -o ". squote($new);
    warn("\n+ $cmd\n") if $verbose > 2;

    my $res = `$cmd 2>&1`;
    die("${res}Aborted\n") if $?;

    utime($time, $time, $new);
}

sub still {
    my ($el) = @_;

    my $new = d_large($el->assoc_name);
    my $still = new Image::Magick;
    if ( $prog_mplayer ) {
	my $tmp = "00000001.jpg";
	my $tmp2 = "00000002.jpg";
	if ( -e $tmp ) {
	    die("ERROR: mplayer needs to create a file $tmp, but it already exists!\n");
	}
	# Sometimes, -frames 1 does not produce anything. Need -frames 2.
	my $cmd = "$prog_mplayer -really-quiet -nojoystick -nolirc -nosound -frames 2 -vo jpeg " .
	  squote(d_large($el->dest_name));
	warn("\n+ $cmd\n") if $verbose > 2;
	my $t = `$cmd 2>&1`;
	warn("$t\n") unless -s $tmp;
	$still->Read($tmp);
	unlink($tmp, $tmp2);
    }
    else {
	# This may take minutes.
	$still->Read(d_large($el->dest_name)."[0]");
    }

    # Get still dimensions.
    my ($hs, $ws) = $still->Get(qw(height width));
    unless ( $hs && $ws ) {
	$still->Read(d_icons("movie.jpg"));
	$still->Write($new);
	return $still;
    }
    # Scale to 640x480 if needed.
    my $r = $hs > $ws ? 640 / $hs : 640 / $ws;
    if ( abs($r - 1) > 0.05 ) {
	$still->Resize(width => $r*$ws, height => $r*$hs);
	($hs, $ws) = $still->Get(qw(height width));
    }

    # Create black canvas.
    my $canvas = new Image::Magick;
    $canvas->Set(size => ($ws+240).'x'.($hs+180));
    $canvas->ReadImage('xc:black');
    my ($hc, $wc) = $canvas->Get(qw(height width));

    # Place the still on top of it.
    # Center image
    $canvas->Composite(image => $still, compose => 'Atop', x => 120, 'y' => 90);
    # Bottom slice.

script/album view on Meta::CPAN

        # Album options. Can also be set in info/config files.
	'captions=s'     => \$caption,
	'cols|columns=i' => \$index_columns,
	'icon!'          => \$icon,
	'medium'         => sub { $medium = 0 },
	'mediumsize=i'   => \$medium,
	'rows=i'         => \$index_rows,
	'thumbsize=i'    => \$thumb,
	'title=s'        => \$album_title,

	# Miscellaneous.
	'debug'          => \$debug,
	'help|?'         => \$help,
	'ident'          => \$ident,
	'quiet'          => sub { $verbose = 0 },
	'test'           => \$test,
	'trace'          => \$trace,
	'verbose+'       => \$verbose,
        )
	 or $help
	 or @ARGV > 1
	 or @ARGV && ! -d $ARGV[0]
       )
    {
	app_usage(2);
    }

    app_ident() if $ident;
    $dest_dir = @ARGV ? shift(@ARGV) : ".";
    $dest_dir =~ s;^\./;;;
    if ( $import_dir ) {
	die("$import_dir: Not a directory\n")
	  unless -d $import_dir;
	$import_dir =~ s;^\./;;;
    }
}

sub app_ident {
    print STDERR ("This is $my_package [$my_name $my_version]\n");
}

sub app_usage {
    my ($exit) = @_;
    app_ident();
    print STDERR heredoc(<<"    EndOfUsage", 4);
    Usage: $0 [options] [ directory ]
      Album:
	--info XXX          description file, default "@{[DEFAULTS->{info}]}" (if it exists)
	--title XXX         album title, default "@{[DEFAULTS->{title}]}"
	--[no]icon          [do not] produce an album icon
      Index:
	--cols NN           number of columns per page, default @{[DEFAULTS->{indexcols}]}
	--rows NN           number of rows per page, default @{[DEFAULTS->{indexrows}]}
	--thumbsize NNN     the max size of thumbnail images, default @{[DEFAULTS->{thumbsize}]}
	--captions XXX      f: filename s: size c: description t: tag
      Medium:
	--medium            produce medium sized images of size @{[DEFAULTS->{mediumsize}]}
	--mediumsize NNN    the max size of medium sized images, default @{[DEFAULTS->{mediumsize}]}
	--mediumonly        ignore large images and links (for web export)
      Importing:
	--import XXX        original images
	--exif              use w/ EXIF info, if possible
	--dcim XXX          as --import with --exif
	--update            add new entries from import, if needed
	--[no]link          [do not] link to original, instead of copying. Default is link.
      Miscellaneous:
	--clobber           recreate everything (except large)
	--test              verify only
	--help              this message
	--ident             show identification
	--verbose           verbose information
    EndOfUsage
    exit $exit if defined $exit && $exit != 0;
}

################ Modules ################

package ImageInfo;

my @std_fields;
my @exif_fields;
my $exif_rot;

INIT {
    @std_fields  = qw(type seq next prev
		      dest_name orig_name assoc_name
		      timestamp file_size medium_size
		      tag description annotation
		      rotation mirror);

    @exif_fields = qw(DateTime ExifImageLength ExifImageWidth
		      ExposureMode ExposureProgram ExposureTime
		      FNumber Flash FocalLength ISOSpeedRatings
		      ImageDescription Make Model
		      MeteringMode SceneCaptureType Orientation
		      height width file_ext);

    $exif_rot = { top_left   => [   0, ''  ],    # 1: no corr. needed
		  top_right  => [   0, 'v' ],    # 2: flop (V)
		  bot_right  => [ 180, ''  ],    # 3: 180
		  bot_left   => [   0, 'h' ],    # 4: flip (H)
		  left_top   => [  90, 'h' ],    # 5: flip 90
		  right_top  => [  90, ''  ],    # 6: 90
		  right_bot  => [  90, 'v' ],    # 7: flop 90
		  left_bot   => [ 270, ''  ],    # 8: 270
		};
}

my $largepat;
sub basename_nolarge {
    my ($f) = @_;
    unless ( $largepat ) {
	$largepat = quotemeta(::d_large());
	$largepat = qr;^$largepat[/\\];;
    }
    $f =~ s;$largepat;;;
    $f;
}

sub new {
    my ($pkg, $file) = @_;
    $pkg = ref($pkg) if ref($pkg);

    my $self = { $file ?
		 (orig_name    => $file,

script/album view on Meta::CPAN

    $info = undef;
    eval {
	require $file;
    };
    if ( $@ ) {
	warn("Illegal cache -- invalidated\n") if $verbose;
	return;
    }
    @{$self}{keys(%$info)} = values(%$info);
}

sub store {
    my ($self, $file) = @_;
    $Data::Dumper::Indent = 1;
    $Data::Dumper::Sortkeys = 1;
    $Data::Dumper::Sortkeys = 1; # avoid warnings
    $Data::Dumper::Purity = 1;
    my $cache = do { local *C; *C };
    open($cache, ">$file")
      and print $cache (Data::Dumper->Dump([$self],[qw(info)]), "\n1;\n")
	and close($cache);
}

sub entry {
    my ($self, $file, $entry) = @_;
    $file =~ s;^\./;;;
    if ( defined $entry ) {
	$self->{$file} = $entry;
    }
    else {
	$entry = $self->{$file};
    }
    $entry;
}

sub entries {
    my ($self) = @_;
    [ sort(keys(%{$self})) ];
}

sub version {
    my ($self) = @_;
    $self->{_version};
}

package main;

=head1 NAME

Album - create and maintain HTML based photo albums

=head1 SYNOPSIS

A photo album consists of a number of (large) pictures, small thumbnail
images, and index pages. Optionally, medium sized images can be
generated as well. The album will be organised as follows:

  index.html       first or only index page
  indexN.html      subsequent index pages (N = 1, 2, ...)
  icons/           directory with navigation icons
  large/           original (large) images, with HTML pages
  medium/          optional medium sized images, with HTML pages
  thumbnail/       thumbnail images

Each image can be labeled with a description, a tag (applies to a
group of images, e.g. a date), the image name, and some
characteristics (size and dimensions).

Images can be handled 'in situ', or imported from e.g. a CD-ROM or
digital camera. Optionally, EXIF information from digital camera files
can be taken into account.

=head1 DESCRIPTION

For a description how to use the program, see L<Album::Tutorial>.

=head1 AUTHOR AND CREDITS

Johan Vromans (jvromans@squirrel.nl) wrote this module.

Web site: http://www.squirrel.nl/people/jvromans/Album/index.html

=head1 COPYRIGHT AND DISCLAIMER

This program is Copyright 2004 by Squirrel Consultancy. All
rights reserved.

This program is free software; you can redistribute it and/or modify
it under the terms of either: a) the GNU General Public License as
published by the Free Software Foundation; either version 1, or (at
your option) any later version, or b) the "Artistic License" which
comes with Perl.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the
GNU General Public License or the Artistic License for more details.

=cut

__END__

Xbegin 644 index.png
XMB5!.1PT*&@H````-24A$4@```"$````A"`````!RCYVS```!?TE$050XC;V3
XMOTM"413'/^JSAR))B3B;0F[A%KGDT-(D+D(0!*W^`[T6EPP:0W`2A":7>+N#
XM+C4(\D9U4&?Q1QB1^"L:>M?W>$HNT7>YY][[.>=^W^$=6Y4MDO1U.;3>^!PF
XM8E)1YUTK$70FXB[`5H7/6PTY8B6:4Z)W;K!5F2A:)./W6HEQ(]>,9EW8H:)%
XMBN$U`.]Q,:)50`*5C/0FSMWRQUP/G9YT6CU'8CF7_;,S02A)Y54/3QX/?[YE
XMV#WRSM@)`0SZ``<R,.U8^A%X`BCD`>Y#0#NEW]C7'%KU%X3P\5X`J`/PO`^,
XMK,0X;V25-M20%+&/DCK5PX"9L">-G-A&'U_JJD;PI2=JQ$S$(BL()5A:==U,
XM@/<"H%X#2.T#(^%7$+O7`-0`DB&@+8C_[7KO$F``P(T,3`W"%VR.7<P:1E8'
XMLR0<SFD_7!9[-]G5?TI+?R7QD"GN&3F>5;3(D0`)XF7M*N-;M]C*-:-Q8^8V
XC2LP<3"KJ)L"8V]^UO6/?/_-HCRMMEKD`````245.1*Y"8((`
X`
Xend
Xbegin 644 medium.png
XMB5!.1PT*&@H````-24A$4@```"$````A"`````!RCYVS```!(DE$050XC;W3
XMOTZ#4!3'\2\4TM3$="!]@"8FLK*Y]@U(]`&<VSJYZ<)2)ZT./$`GZ<CN`&_`
XM*+@T<34-HHE-TS^ZM$+@`I/^EDLXGW`N]^9(/C51=NMFGJ]HC8Q8>.YJEA==
XMU>RU`,F'K^N`IIX7X1)C=`"2S^(JT*U..R^29SLT;EK(X`7ZY*@`:)],],`#
XM&5PLI5`'4(:X(+-9-3LE/WH,(#.?Z<46F<A5Q;\3'W7".8VJQ>-]/`RKA/.P

( run in 0.478 second using v1.01-cache-2.11-cpan-39bf76dae61 )