origin results from the CPAN

Album

    }
}

################ Style Sheets ################

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

sub detab {
    my ($line) = @_;
    return $line unless $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 -vf 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

	'medium'         => sub { $medium = 0 },
	'mediumsize=i'   => \$medium,
	'rows=i'         => \$index_rows,
	'thumbsize=i'    => \$thumb,
	'title=s'        => \$album_title,
	'home=s'         => \$home_link,
	'skew=i'	 => \$skew,

	# 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;^\./;;;
    }
    set_selector($sel);
}

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
        --home XXX          up link for index pages
      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)
	--clobbercss        recreate (overwrite) style sheets
        --select=XXX        select images (default, all, hidden, tag:...)
	--test              verify only
	--help              this message
	--ident             show identification
	--verbose           verbose information
    EndOfUsage
    exit $exit if defined $exit && $exit != 0;
}

sub set_selector {
    my $sel = shift || 'default';
    my $tag;
    if ( $sel =~ /^(tag):(.+)/i ) {
	$sel = 'tag:...';
	if ( $2 =~ /^\/(.+?)\/?$/ ) {
	    $tag = $1;
	}
	else {
	    $tag = quotemeta($2);
	    $tag =~ s/(\\ )+/\\s+/g;
	}
	warn("tag = \"$tag\"\n");
    }
    my %selectors =
      ( default    => sub { ! $_[0]->hidden },
	all        => sub { 1 },
	hidden     => sub { $_[0]->hidden },
	'tag:...'  => sub { $_[0]->tag =~ $tag }
      );
    die("Unknown selection: $sel\n".
	"Possible values are: ", join(", ", sort keys %selectors), ".\n")
      unless $select = $selectors{lc($sel)};
}

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

package ImageInfo;

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

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

    @exif_fields = qw(DateTime DateTimeOriginal ExifImageLength ExifImageWidth
		      ExposureMode ExposureProgram ExposureTime
		      FNumber Flash FocalLength FocalLengthIn35mmFormat
		      FocusMode ISOSpeedRatings
		      ImageDescription Make Model
		      MeteringMode SceneCaptureType Orientation
		      CreateDate MediaCreateDate TimeZone
		      WhiteBalance

script/album view on Meta::CPAN

    $info = undef;
    eval {
	use lib '.';
	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/	   index pages with thumbnails
  icons/           directory with navigation icons
  large/           original (large) images, with HTML pages
  medium/          optional medium sized images, with HTML pages

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://johan.vromans.org/Album/index.html

=head1 COPYRIGHT AND DISCLAIMER

This program is Copyright 2026 by Johan Vromans. All rights reserved.
This program is Copyright 2004,2007 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.557 second using v1.01-cache-2.11-cpan-aadc1410aed )