view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

    $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;
            next unless int((((ord() - 32) & 077) + 2) / 3)
              == int(length() / 4);
            # Decode.
            print $out unpack("u",$_);
            next;
        }

        # Otherwise, search for the uudecode 'begin' line.
        if ( /^Xbegin\s+\d+\s+(.+)$/ ) {
	    next if !$clobber && -s d_icons($1);
	    print STDERR ("Creating icons: ") if $verbose > 1 && !defined($name);
	    $did++;
            $name = d_icons($1);
	    print STDERR ("$1 ") if $verbose > 1;
            open($out, ">$name");
	    binmode($out);
            $doing = 1;         # Doing
            next;
        }
    }
    print STDERR ("\n") if $verbose > 1;
    if ( $doing ) {
        die("Error in DATA: still processing $name\n");
        unlink($name);
    }
}

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

my $add_stylesheet_msg;
sub add_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";

    $add_stylesheet_msg = 0;

    add_stylesheet("common", heredoc(<<"    EOD", 4));
    body {