Album

 view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

################ Formats ################

my $fmt_image_page;
my $fmt_large_page;
my $fmt_medium_page;
my $fmt_index_page;
my $fmt_journal_page;

# <<HereDoc helper to retain a nice program layout.
sub heredoc($$) {
    my ($doc, $indent) = @_;
    $indent = " " x $indent;
    my $res = "";
    foreach ( split(/\n/, $doc) ) {
	my $line = detab($_);
	$line =~ s/^$indent//;
	$res .= $line . "\n";
    }
    $res;
}

script/album  view on Meta::CPAN

      }
      return false
    }
    
    document.onkeypress = handleKey
    </script>
    EOD
    $js;
}

sub button($$;$$) {
    my ($tag, $link, $level, $active) = @_;
    my $Tag = ucfirst($tag);

    $level  = 0 unless defined $level;
    $active = 1 unless defined $active;
    $tag .= "-gr" unless $active;
    $level = "../" x $level;
    $level .= $lib_common . "/" if $lib_common ne "";
    my $b = img("${level}icons/$tag.png", align => "top",
		border => 0, alt => "[$Tag]");
    $active ? "<a class='info' href='$link' alt='[$Tag]'>$b</a>" : $b;
}

sub ixname($) {
    my ($x) = @_;
    "index" . ($x ? $x : "") . ".html";
}

# To aid XHTML compliancy.
sub br { "<br>" }

# Pseudo-smart approach to creating paired single/double quotes.
# Note that the (s-|s\s|t\s) case is specific to the dutch language,
# but probably won't harm other languages...
# Yes, you'll get stupid results with input like rock'n'roll.

sub fixquotes($) {
    my ($t) = @_;

    # HTML::Entities will already have turned " into &quot; -- undo.
    $t =~ s/\&quot;/"/g;
    while ( $t =~ /^([^"]*)"([^"]+)"(.*)/s ) {
	$t = $1 . "&ldquo;" . $2 . "&rdquo;" . $3;
    }
    $t =~ s/"/&quot;/g;

    # HTML::Entities will already have turned ' into &#39; -- undo.

script/album  view on Meta::CPAN

    while ( $t =~ /^([^']*)'([^']+)'(.*)/s ) {
	$t = $1 . "‘" . $2 . "’" . $3;
    }
    $t;
}

# Escape sensitive characters in HTML.
# Two variants: one using HTML::Entities, the other a dumber stub.
# If HTML::Entities is available, it will be used.

sub html($) {
    eval {
	require HTML::Entities;
	# Apply Latin-9 instead of Latin-1.
	no warnings 'once';
	for ( \%HTML::Entities::char2entity ) {
	    $_->{chr(0204)} = '€';
	    $_->{chr(0246)} = 'Š';
	    $_->{chr(0250)} = 'š';
	    $_->{chr(0264)} = 'Ž';
	    $_->{chr(0270)} = 'ž';

script/album  view on Meta::CPAN

	my ($t) = @_;
	return '' unless $t;
	$t =~ s/&/&/g;
	$t =~ s/</&lt;/g;
	$t =~ s/>/&gt;/g;
	fixquotes($t);
    } if $@;
    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->DateTime;

script/album  view on Meta::CPAN

      if ($v = $el->Flash) && $v ne "Flash did not fire";
    $app->("Metering", $v) if $v = $el->MeteringMode;
    $app->("Scene", $v) if $v = $el->SceneCaptureType;
    $app->("Camera",
	   join(" ", $v, $el->Model))
      if $v = $el->Make;
}

#### Caption helpers.

sub f_caption($) {
    my ($el) = @_;
    my $s = htmln($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;

script/album  view on Meta::CPAN

    }

    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");
    }
}