view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

#!/usr/bin/perl -w

# Author          : Johan Vromans
# Created On      : Tue Sep 15 15:59:04 2002
# Last Modified By: Johan Vromans
# Last Modified On: Wed Jul  8 16:55:54 2026
# Update Count    : 3376
# Status          : Unknown, Use with caution!

################ Common stuff ################

use strict;

# Package or program libraries, if appropriate.
# $LIBDIR = $ENV{'LIBDIR'} || '/usr/local/lib/sample';
# use lib qw($LIBDIR);
# require 'common.pl';

use Album;

# Package name.
my $my_package = 'Sciurix';
# Program name and version.
my $my_name = "album";
my $my_version = $Album::VERSION;

my $creator = qq{Created with <a href="https://metacpan.org/dist/Album">Album</a> $my_version};

################ Command line parameters ################

use Getopt::Long 2.13;

# Command line options.
my $import_exif = 0;
my $import_dir;
my $update = 0;			# add new from large/import
our $dest_dir = ".";		# needs occasional 'local'
my $info_file;
my $linkthem = 1;		# link orig to large, if possible
my $clobber = 0;		# overwrite medium/thumbnails
my $mediumonly = 0;		# only medium size (for web export)
my $forcemedium = 0;		# force medium size if large is smaller
my $externalize_css = 0;	# create external css files
my $externalize_formats = 0;	# create external format files
my $select = 'default';		# select images
my $verbose = 1;		# verbose processing

# These are left undefined, for set_defaults. Note: our, not my.
our $index_columns;
our $index_rows;
our $thumb;
our $medium;			# medium size, between large and small
our $album_title;
our $caption;
our $datefmt;
our $icon;
our $locale;
our $lib_common;
our $home_link;
our $skew;			# time skew

# These are not command line options.
my $journal;			# create journal
my $encoding;			# info_file encoding

# Development options (not shown with -help).
my $debug = 0;			# debugging
my $trace = 0;			# trace (show process)
my $test = 0;			# test mode.

# Process command line options.
app_options();

# Post-processing.
$trace |= ($debug || $test);
$dest_dir =~ s;^\./;;;

script/album  view on Meta::CPAN

}

sub entries {
    my ($self) = @_;
    $self->_data([]) unless $self->_data;
    wantarray ? @{$self->_data} : $self->_data;
}

sub tally {
    my ($self) = @_;
    $self->_tally || 0;
}

sub byseq {
    my ($self, $seq) = @_;
    $self->_data ? $self->_data->[$seq-1] : undef;
}

sub filter {
    my ($self, $filter) = @_;
    my $new = FileList->new;
    my $prev;
    foreach my $el ( @{$self->entries} ) {
	next unless $filter->($el);
	my $e = bless { %$el }, 'ImageInfo';	# one level copy
	$e->prev($prev->seq) if $prev;
	$new->add($e);
	$prev->next($e->seq) if $prev;
	$prev = $e;
    }
    return $new;
}

#### Cache maintenance.

package ImageInfoCache;

use constant CACHE_VERSION => 3;

sub new {
    my ($pkg, $file) = @_;
    $pkg = ref($pkg) || $pkg;
    my $self = bless({}, $pkg);
    if ( defined($file) ) {
	$self->load($file);
	if ( ($self->{_version} || 1) != CACHE_VERSION ) {
	    warn("Incompatible cache version " . $self->version .
		 " -- invalidated\n") if $verbose;
	    $self = bless({}, $pkg);
	}
    }
    $self->{_version} = CACHE_VERSION;
    $self;
}

sub load {
    my ($self, $file) = @_;
    our $info;
    $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