Album

 view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

# warn("date => ", strftime($datefmt, localtime(time)), "\n");

# Verify and update the file list.
my $added = update_filelist();

# Perform selection. Normally, hidden entries are ignored.
# Option --select=all overrides this.
$filelist = $filelist->filter($select);

#print STDERR Data::Dumper->Dump([$filelist],[qw(filelist)]);

my $num_entries = $filelist->tally;
print STDERR ("Number of entries = $num_entries",
	      $added ? " ($added added)" : "",
	      "\n") if $verbose > 1;
die("Nothing to do?\n") unless $num_entries > 0;
exit(0) if $test;

# Clean up and create directories.
if ( $clobber ) {
    rmtree([d_index(), d_medium()], $verbose > 1);
    rmtree([d_journal()], $verbose > 1);
}
mkpath([d_index(), d_large(), d_icons()], $verbose > 1);
mkpath([d_medium()], $verbose > 1) if $medium;

# Copy images in place, rotate if necessary, and create the thumbnails.
prepare_images();

# Update cache.
update_cache();
my $cache_update = 0;

my $entries_per_page = $index_columns*$index_rows;
my $num_indexes = int(($num_entries - 1) / $entries_per_page) + 1;

my $fn = "img0000";
# Cleanup excess files.
for ( 0 ) {
    my $excess = $fn++ . ".html";
    unlink(d_medium($excess));
    unlink(d_large($excess)) or last;
}

# Map file names to html pages. Start with 1 to match "image N of M".
my @htmllist;
for my $i ( 0 .. $num_entries-1 ) {
    $htmllist[$i] = $fn++ . ".html";
}

# Cleanup excess files.
for (my $i = $num_entries ; ; $i++ ) {
    my $excess = $fn++ . ".html";
    unlink(d_medium($excess));
    unlink(d_large($excess)) or last;
}

# Copy the button images over to the target directory.
add_button_images();

# Init formats and stylesheets.
init_formats();
init_stylesheets();

# Write the individual pages.
write_image_pages();

# Write the index pages.
write_index_pages();

# Write the journal.
write_journal_pages();

# Create index & icon.
create_master_index();
create_index_icon();

# Final update, if needed.
update_cache() if $cache_update;

exit 0;

################ Subroutines ################

# Image types.
use constant T_JPG    => 1;
use constant T_MPG    => 2;
use constant T_VOICE  => 3;	# still image + sound
# Pseudo types.
use constant T_PSEUDO => 0;
use constant T_TAG    => -1;
use constant T_ANN    => -2;
use constant T_REF    => -3;

# List of possible subdirs to process.
my @subdirs;

# Journal tags
my %jnltags;


# fjoin is used for generating file names.
sub fjoin	 { File::Spec->catfile(@_); }

# hjoin is used for generating html paths
sub hjoin	 { join("/", @_); }

# $fjoin will be dynamically switched depending on context.
our $fjoin; INIT { $fjoin = \&fjoin }

sub d_dest       { unshift(@_, $dest_dir) unless $dest_dir eq ".";
		   $fjoin->(@_); }
sub d_index      { unshift(@_, "index");      goto &d_dest; }
sub d_large      { unshift(@_, "large");      goto &d_dest; }
sub d_medium     { unshift(@_, "medium");     goto &d_dest; }
sub d_journal    { unshift(@_, "journal");    goto &d_dest; }
sub d_up	 { unshift(@_, "..");         goto &d_dest; }

sub d_destc      { unshift(@_, $lib_common) if $lib_common; goto &d_dest; }
sub d_icons      { unshift(@_, "icons");      goto &d_destc; }
sub d_css        { unshift(@_, "css");        goto &d_destc; }
sub d_fmt        { unshift(@_, "formats");    goto &d_destc; }

script/album  view on Meta::CPAN

    $format_for{medium} = $load->("medium.fmt", $format_for{image});

    # Format for journal pages (mostly).
    #
    # Variables:
    #
    #  $title
    #  $tag
    #  $vbuttons / $hbuttons
    #  $journal
    #  $jscript

    $format_for{journal} = $load->("journal.fmt", heredoc(<<'    EOD', 4));
    <?xml version="1.0" encoding="iso-8859-15"?>
    <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
    <!-- ALBUM-FMT-VERSION: 2.0 -->
    <html>
      <head>
	<title>$title</title>
        $css
	$jscript
      </head>
      <body>
	<table class='outer'>
	  <tr class='grey'>
	    <td>
	      <p class='hdl'>
		$tag
	      </p>
	    </td>
	    <td class='buttons'>
	      $hbuttons
	    </td>
	  </tr>
	  $journal
	  <tr class='grey'>
	    <td></td>
	    <td class='buttons'>
	      $hbuttons
	    </td>
	  </tr>
	</table>
      </body>
    </html>
    EOD

    print STDERR ("\n") if $did;
}

sub process_fmt {
    my ($fmt, %map) = @_;
    # THIS DOES ONLY ONE SUBST PER LINE
    $fmt =~ s/^(.*?)\$(\w+)\b/$1.indent($map{$2}, length($1))/gme;
    $fmt;
}

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

my %css_for;

sub init_stylesheets {

    my $css_fontfam = "font-family: Verdana, Arial, Helvetica";
    my $WHITE = "#FFFFFF";
    my $BLACK = "#000000";
    my $RED   = "#FF0000";
    my $LGREY = "#E0E0E0";
    my $MGREY = "#D0D0D0";
    my $DGREY = "#C0C0C0";
    my $DDGREY = "#B0B0B0";
    my $BLUE  = "#0000FF";
    # Grey variants for index table borders.
    my $GR245 = "#F5F5F5";
    my $GR232 = "#E8E8E8";
    my $GR124 = "#7C7C7C";
    my $GR114 = "#727272";

    my $helper = $thumb + 4;

    my $did = 0;
    my $load = sub {
	my ($req, $data) = @_;
	my $css = d_css($req.".css");
	if ( -r $css ) {
	    my $major = $css_major;
	    my $minor = $css_minor;
	    my $orig;
	    if ( open(my $orig, "<", d_fmt("$req.fmt")) ) {
		my $line = <$orig>;
		close($orig);
		if ( $line =~ m;/\*\s*album-fmt-version:\s*(\d+)\.(\d+)\s*\*/;i ) {
		    ($major, $minor) = ($1, $2);
		}
	    }
	    # Check stylesheet compatibility.
	    open($orig, "<", $css);
	    my $line = <$orig>;
	    close($orig);
	    if ( $line =~ m;/\*\s*album-css-version:\s*(\d+)\.(\d+)\s*\*/;i ) {
		if ( $1 == $major ) {
		    return "";
		}
	    }
	    print STDERR "\n" if $did;
	    die(heredoc(<<"            EOD", 8));
	    *************************************************************************
	    Existing style sheet $req.css is not compatible with this version.
	    It has probably been created by an older version of this program, or it
	    has been modified manually.

	    If you did not change any style sheets, just remove the css directory and
	    try again.

	    If you did modify the style sheets move them away to a backup location,
	    run the program with '--extcss', and apply your changes to the new style
            sheets.
	    *************************************************************************
            EOD
	}
	elsif ( $externalize_css ) {
	    unless ( $did ) {
		my $fdir = d_css("");
		$fdir =~ s/\/+$//;
		unless ( -d $fdir ) {
		    print STDERR ("mkdir $fdir\n");
		    mkdir(d_css(""));
		}
	    }
	    print STDERR ("Creating stylesheets: ") if $verbose > 1 && !$did++;
	    print STDERR ("$req ") if $verbose > 1;
	    open (my $fh, '>', $css) || die("$css: $!\n");
	    print { $fh } $data;
	    close($fh);
	}
	$data =~ s/^([ \t]+)/detab($1)/gem;
	$data;
    };

    my $css_for_common = heredoc(<<"    EOD", 0);

    body {
	$css_fontfam;
	font-size:  80%;
	text: $BLACK;
    }

    a:link {
	color: $BLACK; text-decoration: none;
    }
    a:visited {
	color: $BLACK; text-decoration: none;
    }
    a:active {
	color: $RED; text-decoration: none;
    }

    img.image {
	border: 2px solid $BLACK;
    }

    img.button {
	border: 0;
	vertical-align: top;
    }

    table.vb {
	border: 0;
	border-spacing: 0 0;
    }
    table.vb td {
	padding: 0 0 0 0;
    }
    table.hb {
	border: 0;
	border-spacing: 0 0;
    }
    table.hb td {
	padding: 0 0 0 0;
    }
    EOD

    my $css_for_ipage = heredoc(<<"    EOD", 0);
    $css_for_common
    body {
	background: $DGREY;
    }
    td {
	font-size:  80%;
    }
    p.hdl, p.hdr {
	font-size: 140%; font-weight: bold;
	margin-top: 0; margin-bottom: 0;
    }
    p.ftl, p.ftr {
	font-size:  80%;
	margin-top: 0; margin-bottom: 0;
    }
    td.topleft {
	text-align: left;
	vertical-align: top;
    }
    td.topright {
	text-align: right;
	vertical-align: top;
    }
    td.image {
	text-align: center;
	vertical-align: top;
    }
    td.botleft {
	text-align: left;
	vertical-align: top;
    }
    td.botright {
	text-align: right;
	vertical-align: top;
    }
    td.vbuttons {
	vertical-align: top;
    }
    EOD

    $css_for{index} = $load->("index", heredoc(<<"    EOD", 4));
    /* ALBUM-CSS-VERSION: ${css_major}.${css_minor} */
    $css_for_ipage
    a.info {
	position: relative; z-index: 24; background-color: $LGREY;
	color: $BLACK; text-decoration:none;
    }
    a.info:hover {
	z-index: 25; background-color: $LGREY;
    }
    a.info:hover span {
	display: block;
	position: absolute; top: 2em; left: 2em; width: 25em;
	border: 0px; background-color: $MGREY; color: $BLACK;
	text-align: center;
    }
    a.info span {
	display: none;
    }
    table.outer {
	background: $MGREY;
	border-collapse: separate;
	border-width: 2px;           /* border=2 */
	border-style: solid;
	border-color: $GR232 $GR114 $GR114 $GR232;
	border-spacing: 3px;        /* cellspacing = 3 */
    }
    table.outer tr {
	background: $LGREY;
    }
    table.outer td {
	border-width: 1px;
	border-style: solid;
	border-color: $GR124 $GR245 $GR245 $GR124;
    }
    table.inner {
	/* need a width otherwise we cannot center it */
	width: ${helper}px;
	border: outset 0px;
    }
    table.inner td {
	border: inset 0px;
        padding: 0 0 0 0;
    }
    p.hdr {
	font-size: 140%; font-weight: bold;
	margin-top: 0; margin-bottom: 0;
    }
    p.hdr a:link {
	color: $BLACK; text-decoration: underline;
    }
    p.hdr a:visited {
	color: $BLACK; text-decoration: underline;
    }
    p.hdr a:hover {
	color: $RED; text-decoration: underline;
    }
    td.vimage {
	vertical-align: top;
    }
    td.oimg {
	text-align: center;
	vertical-align: bottom;
    }
    td.iimg {
	text-align: center;
    }
    td.itxt {
	text-align: center;
    }
    img.thumb {
	border: 0;
    }
    EOD

    my $css_for_image = heredoc(<<"    EOD", 4);
    /* ALBUM-CSS-VERSION: ${css_major}.${css_minor} */
    $css_for_ipage
    a.info {
	position: relative; z-index: 24; background-color: $DGREY;
	color:$BLACK; text-decoration:none;
    }
    a.info:hover {
	z-index: 25; background-color: $DGREY;
    }
    a.info span {
	display: none;
    }
    a.info:hover span {
	display: block;
	position: absolute; top:2em; left: 2em; width: 15em;
	border: 0px; background-color: $MGREY; color: $BLACK;
	text-align: center;

script/album  view on Meta::CPAN

	width: 600px;
	border-spacing: 10px;
    }
    tr.grey {
	background: $DGREY;
    }
    table.outer td.twocol {
	vertical-align: top;
	text-align: left;
    }
    table.outer td.jl {
	vertical-align: top;
	text-align: left;
    }
    table.outer td.jr {
	width: ${thumb}px;
	vertical-align: top;
        text-align: center;
        background: $LGREY;
    }
    table.outer td.buttons {
	vertical-align: middle;
	text-align: right;
	padding-right: 0.1in;
    }
    EOD

    $css_for{main} = $load->("main", heredoc(<<"    EOD", 4));
    /* ALBUM-CSS-VERSION: ${css_major}.${css_minor} */
    body {
        $css_fontfam;
        font-size:  80%;
        background: $LGREY;
        background-image: url("icons/bg.jpg");
        background-repeat: no-repeat;
        background-position: 10% 60%;
    }
    p.ftr {
        padding-left: 10%;
        padding-top: 40%;
        font-size:  80%;
        text-align: left;
        color: $DDGREY;
    }
    p.indextitle {
        padding-left: 10%;
        font-size: 500%;
        font-weight: bold;
        color: $WHITE;
    }
    p.indextitle a {
        text-decoration: none;
        color: $WHITE;
    }
    EOD
}

sub css_for {
    my ($type) = shift(@_);
    defined(my $css = $css_for{$type}) or die("PROGRAM ERROR: css_for($type)");
    return qq{<link rel="stylesheet" href="}.d_up(d_css($type.".css")).qq{">}
      unless $css;
    qq{<style type=\"text/css\">\n} . $css . qq{</style>};
}

################ Helpers for Image/Index/Journal pages ################

sub jscript {
    my (%nav) = @_;
    my $next = $nav{next};
    my $prev = $nav{prev};
    my $up   = $nav{up};
    my $down = $nav{down};
    my $idx  = $nav{idx};
    my $jnl  = $nav{jnl};
    my $js = heredoc(<<"    EOD", 4);
    <script type='text/javascript'>
    function handleKey(e) {
      var key;
      if ( e == null ) { // IE
	key = event.keyCode
      }
      else { // Mozilla
	if ( e.altKey || e.ctrlKey ) {
	  return true
	}
	key = e.which
      }
      switch(key) {
    EOD

    $js .= "    case   8: window.location = '$prev'; break // Backspace\n" if $prev;
    $js .= "    case  32: window.location = '$next'; break // Space\n"     if $next;
    $js .= "    case  13: window.location = '$down'; break // Enter\n"     if $down;
    $js .= "    case  43: window.location = '$down'; break // '+'\n"       if $down;
    $js .= "    case 117: window.location = '$up'; break // 'u'\n"         if $up;
    $js .= "    case  45: window.location = '$up'; break // '-'\n"         if $up;
    $js .= "    case 100: window.location = '$idx'; break // 'd'\n"        if $idx;
    $js .= "    case 106: window.location = '$jnl'; break // 'j'\n"        if $jnl;

    $js .= heredoc(<<"    EOD", 4);
       default:
      }
      return false
    }
    
    document.onkeypress = handleKey
    </script>
    EOD
    $js;
}

sub button($$;$$) {
    my ($tag, $link, $level, $active) = @_;
    my $Tag = ucfirst($tag);
    local $fjoin = \&hjoin;

    $level  = 0 unless defined $level;
    $active = 1 unless defined $active;
    $tag .= "-gr" unless $active;
    my @path;
    push(@path, ("..") x $level) if $level;
    push(@path, d_icons("$tag.png"));

script/album  view on Meta::CPAN

	    $t =~ s/>/&gt;/g;
	    fixquotes($t);
	};
    }
    goto &html;
}

sub htmln($) {
    # Escape HTML sensitive characters, and turn newlines into <br>.
    my $t = html(shift);
    return '' unless $t;
    $t =~ s/\n+/$br/go;
    $t;
}

sub indent($$) {
    # Shift contents to the right so it fits pretty.
    my ($t, $n) = @_;
    $n = " " x $n;
    return $n unless $t;
    $t = detab($t);
    $t =~ s/\n+$//;
    $t =~ s/\n/\n$n/g;
    $t;
}

sub img($%) {
    my ($file, %atts) = @_;
    my $ret = "<img src='" . $file . "'";
    foreach ( sort(keys(%atts)) ) {
	$ret .= " $_='" . $atts{$_} . "'";
    }
    $ret . "/>";
}

#### Size helpers.

sub bytes($) {
    my $t = shift;
    return $t . "b" if $t < 10*1024;
    return ($t >> 10) . "kb" if $t < 10*1024*1024;
    ($t >> 20) . "Mb";
}

sub size_info($;$) {
    my ($el, $med) = @_;
    return unless $el->width;

    my $ret = "";
    $ret .= $el->width . "x" . $el->height if $el->width;
    for ( $med ? $el->medium_size : $el->file_size ) {
	next unless $_;
	$ret .= "," if $ret;
	$ret .= bytes($_);
    }
    $ret;
}

#### EXIF helpers.

sub restyle_exif($) {
    my ($el) = @_;
    my $ret = "";
    my $v;

    my $app = sub {
	$ret .= "<tr><td>".htmln($_[0])."</td>".
	            "<td>".htmln($_[1])."</td></tr>\n";
    };

    $app->("Date", $v) if $v = $el->xDateTime;
    my $t = $el->ExposureTime || 0;
#    if ( $t && $t <= 0.5 ) {
#	$t = "1/".int(0.5 + 1/$t)."s";
#    }
    $app->("Exposure",
	   join(" ", $el->ExposureMode || "",
		$el->ExposureProgram || "", $t)) if $t;
    $app->("Aperture", sprintf("%.1f", $v))
      if $v = $el->FNumber;
    if ( $v = $el->FocalLength ) {
	if ( my $v2 = $el->FocalLengthIn35mmFormat ) {
	    $v .= " ($v2 eqv.)";
	}
	$app->("Focal length", $v);
    }
    $app->("ISO", $v) if $v = $el->ISOSpeedRatings;
    $app->("Flash", $v)
      if ($v = $el->Flash) && $v !~ /did not fire/i;
    $app->("Metering", $v) if $v = $el->MeteringMode;
    $app->("FocusMode", $v) if ($v = $el->FocusMode) && $v ne 'Auto';
    $app->("WhiteBalance", $v) if ($v = $el->WhiteBalance) && $v ne 'Auto';
    $app->("Scene", $v) if ($v = $el->SceneCaptureType) && $v ne 'Standard';
    $app->("Camera", join(" ", $v, $el->Model)) if $v = $el->Make;
}

#### Caption helpers.

sub f_caption($) {
    my ($el) = @_;
    my $s = htmln($el->type == T_REF ? $el->orig_name : $el->dest_name);
    if ( $el->Make ) {
	$s = "&nbsp;$s<a href='#' class='info'>&nbsp;<span>".
	  "<table border='1' width='100%'>\n".
	    restyle_exif($el) . "</table>\n".
	      "</span></a>";
    }
    $s;
}

sub s_caption($) {
    my ($el) = @_;
    size_info($el, $medium);
}

sub t_caption($) {
    my ($el) = @_;
    $el->tag  ? htmln($el->tag) : "";
}

sub c_caption($) {
    my ($el) = @_;
    my $t = $el->description || "";
    $t =~ s/\n.*//;
    htmln($t);
}

#### Misc.

sub update_if_needed($$) {
    my ($fname, $new) = @_;

    # Do not overwrite unless modified.
    if ( -s $fname && -s _ == length($new) ) {
	local($/);
	my $hh = do { local *F; *F };
	my $old;
	open($hh, "<", $fname) && ($old = <$hh>) && close($hh);
	if ( $old eq $new ) {
	    return 0;
	}
    }

    my $fh = do { local *F; *F };
    open($fh, ">", $fname)
      or die("$fname (create): $!\n");
    print $fh $new;
    close($fh);
    1;
}

sub uptodate($$) {
    my ($type, $mod) = @_;
    if ( $mod ) {
	print STDERR ("(Needed to write ", $mod,
		      " $type page", $mod == 1 ? "" : "s", ")\n");
    }
    else {
	print STDERR ("(No $type pages needed updating)\n");
    }
}

################ Image Pages ################

sub write_image_pages {

script/album  view on Meta::CPAN

    my @b = (
	     ($dir eq "large" && $medium) ?
	     button("medium", d_up(d_medium($htmllist[$i])),           1, 1) :
	     button("index",  d_up(ixname(int($i/$entries_per_page))), 1, 1),
	     button("first",  $htmllist[0],                            1, $i > 0),
	     button("prev",   $htmllist[$prev] || "",                  1, $prev >= 0),
	     button("next",   $htmllist[$next] || "",                  1, $next < $num_entries),
	     button("last",   $htmllist[-1],                           1, $i < $num_entries-1));

    if ( $journal && exists $jnltags{$el->tag} ) {
	my $page = d_up(d_journal("jnl" . $jnltags{$el->tag} . ".html#img".sprintf("%04d", $i+1)));
	push(@b, button("journal", $page, 1, 1));
	$nav{jnl} = $page;
    }
    if ( $el->type == T_VOICE ) {
	my $sound = $el->assoc_name;
	push(@b, button("sound", d_up(d_large($sound)), 1, 1));
    }

    my $imglink;
    if ( $dir eq "medium" ) {
	if ( $mediumonly ) {
	    $imglink = img($file, alt => "[Image]", class => "image");
	}
	elsif ( $movie ) {
	    $imglink = "<a href='" . d_up(d_large($el->dest_name)) . "'>" .
	      img($file, alt => "[Movie]", class => "image") .
		"</a>";
	    $nav{down} = d_up(d_large($el->dest_name));
	}
	else {
	    $imglink = "<a href='" . d_up(d_large($htmllist[$i])) . "'>" .
	      img($file, alt => "[Image]", class => "image") .
		"</a>";
	    $nav{down} = d_up(d_large($htmllist[$i]));
	}
    }
    else {
	if ( $movie ) {
	    $imglink = "<a href='" . $el->dest_name . "'>" .
	      img($file, alt => "[Movie]", class => "image") .
		"</a>";
	}
	else {
	    $imglink = img($file, alt => "[Image]", class => "image");
	}
	$nav{up} = d_up(d_medium($htmllist[$i]));
    }

    my $auxright = htmln($el->dest_name);
    my $s = size_info($el);
    $auxright .= " ($s)" if $s;
    $auxright .= "&nbsp;&nbsp;&nbsp;$creator" if $creator;
    my $auxleft  = htmln($el->tag || "");

    my $it2 = $it;
    if ( $el->Make ) {		# EXIF info
	$it2 = "<a href='#' class='info'>" . ($it || "&nbsp;") .
	  "<span>" .
	    "<table border='1' width='100%'>\n" .
	      restyle_exif($el) . "</table>\n" .
		"</span></a>";
    }
    my $tt2 = $tt;

    if ( $dir eq "medium" && $el->annotation ) {
	my @a = UNIVERSAL::isa($el->annotation, "ARRAY")
	  ? @{$el->annotation} : ($el->annotation);
	my $t = "";
	foreach ( reverse(@{$el->annotation}) ) {
	    next unless $_;
	    my $x = $_;		# copy
	    $x = html($x) unless $x =~ /^</;
	    $t .= "<p>\n" if $t;
	    $t .= $x;
	}
	$tt2 = "<a href='#' class='info'>" . $tt .
	  "<span>" .
	    "<table border='1' width='100%'>\n" .
	      "<tr><td>$t</td></tr>" .
		"</table>\n" .
		  "</span></a>" if $t;
    }

    # Restore local scope.
    $fjoin = \&fjoin;
    $dest_dir = $orig_dd;

    update_if_needed(d_dest($dir, $htmllist[$i]),
		     process_fmt($format_for{$dir},
				 title	  => $it || $tt,
				 css      => css_for($dir),
				 dir	  => $dir,
				 ltop	  => $it2,
				 rtop	  => $tt2,
				 hbuttons => hbuttons(@b),
				 vbuttons => vbuttons(@b),
				 jscript  => jscript(%nav),
				 image	  => $imglink,
				 lbot	  => $auxleft,
				 rbot	  => $auxright,
				));
}

################ Index Pages ################

sub write_index_pages {
    print STDERR ("Creating ", $num_indexes, " index page",
		  $num_indexes == 1 ? "" : "s", "\n") if $verbose > 1;
    my $mod = 0;
    for my $i ( 0 .. $num_indexes-1 ) {
	write_index_page($i) && $mod++;
    }
    uptodate("index", $mod) if $verbose > 1;

    # Cleanup excess indices.
    for (my $i = $num_indexes ; ; $i++ ) {
	unlink(d_dest("index$i.html")) or last;
    }
}

script/album  view on Meta::CPAN


	# 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
		      height width file_ext);

    $exif_rot = { top_left   => [   0, ''  ],    # 1: no corr. needed



( run in 1.030 second using v1.01-cache-2.11-cpan-a49fcb8fa48 )