Album

 view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

	    $el->timestamp($time);
	    $file = "$new.$ext";
	    cache_entry($file, $el) unless $ii;
	}
	else {
	    warn(fjoin($import_dir, $file).": Missing or unparsable file date [$fd]\n")
	      if $verbose;
	    $el->type(T_JPG);
	}
	if ( $next && $next eq "$type$seq.mpg" ) {
	    warn(fjoin($import_dir, $file).": Changed to VOICE\n") if $verbose;
	    $el->type(T_VOICE);
	    (my $t = $file) =~ s/\.jpg$/.mp3/i;
	    $el->assoc_name($t);
	    $implist->add($el);
	    return 1;
	}
	$implist->add($el);
    }

    # MPEG movie.
    elsif ( $file =~ /^(.{4})(\d{4})\.($movpat)$/i ) {
	my ($type, $seq, $ext) = ($1, $2, $3);
	# We have to trust the file date...
	my $time = $el->timestamp;
	my @tm = localtime($time);
	my $new = sprintf("%04d%02d%02d%02d%02d%02d$seq",
			  1900+$tm[5], 1+$tm[4], @tm[3,2,1,0]);
	my $ii = cache_entry("$new.$ext");
	if ( $ii && !$ii->orig_name ) {
	    $ii->orig_name(fjoin($import_dir, $file));
	}

	$el->type(T_MPG);
	$el->dest_name("$new.$ext");
	$el->assoc_name($new."s.jpg");
	$implist->add($el, "$new.$ext");
	$file = "$new.$ext";
	cache_entry($file, $el) unless $ii;
    }

    # Assume ordinary JPEG or some picture.
    elsif ( $file =~ /^.*$picpat$/) {
	$el->type(T_JPG);
	$el->orig_name(fjoin($import_dir, $file));
	$el->dest_name($file);
	$implist->add($el, $file);
    }

    # Assume ordinary MPEG or some movie.
    elsif ( $file =~ /^(.*)($movpat)$/) {
	$el->type(T_MPG);
	$el->orig_name(fjoin($import_dir, $file));
	$el->dest_name($file);
	$el->assoc_name($1."s.jpg");
	$implist->add($el, $file);
    }
    return 0;
}

sub update_filelist {
    my $todo = new FileList;

    my $el;
    my %seen;
    my $missing;
    my $prev;

    foreach $el ( $filelist->entries ) {
	my $f = $el->dest_name;
	$seen{$f}++;
	print STDERR ("todo[inf]: $f") if $trace;
	my $entry = $gotlist->byname($f);
	if ( $entry ) {
	    print STDERR (" -- got") if $trace;
	}
	elsif ( $entry = $implist->byname($f) ) {
	    print STDERR (" -- imp") if $trace;
	}
	elsif ( $el->type == T_REF ) {
	    $entry = $el;
	    print STDERR (" -- ref") if $trace;
	}
	if ( $entry ) {
	    unless ( $el->description =~ /^--($|\s)/ ) {
		# Copy properties from info.
		$entry->tag($el->tag);
		$entry->description($el->description);
		$entry->annotation($el->annotation);
		$entry->_rotation($el->_rotation);
		# Add and create prev/next links.
		$entry->prev($prev->seq) if $prev;
		$todo->add($entry);
		$prev->next($entry->seq) if $prev;
		print STDERR ("\n") if $trace;
	    }
	    else {
		print STDERR (" (ignored)\n") if $trace;
		undef $entry;
	    }
	}
	else {
	    if ( $trace ) {
		print STDERR ("\n");
	    }
	    else {
		unless ( $el->description =~ /^--($|\s)/ ) {
		    print STDERR ("todo[inf]: $f -- missing\n");
		}
	    }
	    unless ( $el->description =~ /^--($|\s)/ ) {
		$missing++;
	    }
	}
	$prev = $entry if $entry && $entry->type != T_REF;
    }
    die("Aborted!\n") if $missing;

    unless ( $filelist->tally == 0 || $update ) {
	$filelist = $todo;
	return 0;

script/album  view on Meta::CPAN

    if ( $t && $t <= 0.5 ) {
	$t = "1/".int(0.5 + 1/$t)."s";
    }
    $app->("Exposure",
	   join(" ", $el->ExposureMode || "",
		$el->ExposureProgram || "", $t));
    $app->("Aperture", sprintf("%.1f", $v))
      if $v = $el->FNumber;
    if ( $v = $el->FocalLength ) {
	if ( $el->Model eq "DSC-V1" ) {
	    $v .= sprintf("mm  (%.1fmm equiv.)", $v*4.857);
	}
	else {
	    $v .= "mm";
	}
	$app->("Focal length", $v);
    }
    $app->("ISO", $v) if $v = $el->ISOSpeedRatings;
    $app->("Flash", $v)
      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;
	}
    }

    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 {
    print STDERR ("Creating ", $num_entries, " image page",
		  $num_entries == 1 ? "" : "s", "\n") if $verbose > 1;
    my $mod = 0;

    for my $el ( $filelist->entries ) {
	write_image_page($el, "large") && $mod++;
	write_image_page($el, "medium") && $mod++ if $medium;
    }
    uptodate("image", $mod) if $verbose > 1;
}

sub write_image_page {
    my ($el, $dir) = @_;

    if ( $el->type <= T_PSEUDO ) {
	warn("PSEUDO: ", Dumper($el)) unless $el->type == T_REF;
	return;
    }

    my $i = $el->seq - 1;
    my $file = $el->dest_name;
    my $rf = $file;

    # Try movie.
    my $movie = $el->type == T_MPG;

script/album  view on Meta::CPAN

		    "    " . indent($img, 4) . "\n".
		    "  </td>\n".
		    "</tr>\n";
	    $seq++;
	}
	my @b = ( button("first", $jname->(1),         1, $x > 0         ),
		  button("prev",  $jname->($x),        1, $x > 0         ),
		  button("next",  $jname->($x+2),      1, $x < $journal-1),
		  button("last",  $jname->($journal),  1, $x < $journal-1),
		  button("index", "../index$ix.html",  1, 1             ),
	     );
	my %nav = ( up  => "../index$ix.html",
		    idx => "../index$ix.html" );
	$nav{prev} = $jname->($x) if $x > 0;
	$nav{next} = $jname->($x+2) if $x < $journal-1;

	$x++;

	update_if_needed(d_journal("jnl" . $jnltags{$tag} . ".html"),
			 process_fmt($fmt_journal_page,
				     title    => "Journal: " . htmln($tag),
				     tag      => htmln($tag),
				     hbuttons => join("", @b),
				     vbuttons => join("$br\n", @b),
				     journal  => $jnl,
				     jscript  => jscript(%nav),
				    ));
    };

    my $mod = 0;

    foreach my $el ( @journal ) {
	my $t = $el->type;
	if ( $t == T_TAG ) {
	    $flush->() && $mod++ if @ann;
	    $tag = $el->tag;
	    @ann = ();
	}
	else {
	    push(@ann, $el);
	}
    }
    $flush->() && $mod++ if @ann;

    $mod;
}

################ ################

#### Persistent info (cache) helpers.

{ my $cache;

  my @stats; INIT { @stats = (0, 0, 0); }

  sub load_cache {
    $cache = new ImageInfoCache
      ((!$clobber && -s d_dest(".cache")) ? d_dest(".cache") : undef);
  }

  sub update_cache {
    $cache->store(d_dest(".cache"));
  }

  sub cache_entry {
      if ( @_ == 1 ) {
	  $stats[0]++;
	  my $ii = $cache->entry(@_);
	  $stats[1]++ if $ii;
	  warn("Cache miss: $_[0]\n") if !$ii && $trace;
	  return $ii;
      }
      $stats[2]++;
      $cache->entry(@_);
  }

  END {
      print STDERR ("Cache: store = $stats[2], lookup = $stats[0], hits = $stats[1]\n")
	if $trace;
  }
}

#### Miscellaneous.

sub findexec {
    my ($bin) = @_;
    foreach ( File::Spec->path ) {
	my $try = File::Spec->catfile($_, $bin);
	return $try if -x $try;
    }
    undef;
}

sub squote {
    my ($t) = @_;
    $t =~ s/([\\\"])/\\$1/g;
    $t = '"'.$t.'"' if $t =~ /[^-\w.\/]/;
    $t;
}

################ Button Images ################

sub add_button_images {
    # Extract button images from DATA section.

    my $out = do { local *OUT; *OUT };
    my $name;
    my $doing = 0;
    my $did = 0;

    while ( <DATA> ) {
        if ( $doing ) {         # uudecoding...
            if ( /^Xend/ ) {
                close($out);
                $doing = 0;	# Done
		next;
            }
            # Select lines to process.
            next if /[a-z]/;
	    next unless /^X(.*)/s;
	    $_ = $1;