view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

#!/usr/bin/perl -w
my $RCS_Id = '$Id: album.pl,v 1.86 2007/04/02 09:07:50 jv Exp $ ';

# Author          : Johan Vromans
# Created On      : Tue Sep 15 15:59:04 2002
# Last Modified By: Johan Vromans
# Last Modified On: Mon Apr  2 11:07:05 2007
# Update Count    : 2830
# Status          : Unknown, Use with caution!

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

$VERSION = "1.06";

use strict;

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

# Package name.
my $my_package = 'Sciurix';
# Program name and version.
my ($my_name, $my_version) = $RCS_Id =~ /: (.+).pl,v ([\d.]+)/;
# Tack '*' if it is not checked in into RCS.
$my_version .= '*' if length('$Locker:  $ ') > 12;

my $creator = "Created with <a href=\"http://search.cpan.org/~jv/Album/\">Album</a> $::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
my $dest_dir = ".";
my $info_file;
my $linkthem = 1;		# link orig to large, if possible
my $clobber = 0;
my $mediumonly = 0;		# only medium size (for web export)
my $externalize_formats = 0;	# create external format files
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;

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

# 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;^\./;;;
$import_dir =~ s;^\./;; if $import_dir;

################ Presets ################

use constant DEFAULTS => { info       => "info.dat",
			   title      => "Photo Album",
			   medium     => 0,
			   mediumsize => 915,
			   thumbsize  => 200,
			   indexrows  => 3,
			   indexcols  => 4,
			   caption    => "fct",
			   captionmin => "f",
			   dateformat => '%F',
			   icon	      => 0,
			 };

my $TMPDIR = $ENV{TMPDIR} || $ENV{TEMP} || '/usr/tmp';

my $picpat = qr{(?i:jpe?g|png|gif)};
my $movpat = qr{(?i:mpe?g|mov|avi)};
my $xtrpat = qw{(?i:html?)};
my $suffixpat = qr{\.$picpat|$movpat};
my $xsuffixpat = qr{\.$picpat|$movpat|$xtrpat};

my %capfun = ('c' => \&c_caption,
	      'f' => \&f_caption,
	      's' => \&s_caption,
	      't' => \&t_caption,
	     );

my $br = br();

# Max.number of clickable index numbers (should be odd).
use constant IXLIST => 15;

# Helper programs
my $prog_jpegtran  = findexec("jpegtran");
my $prog_mplayer   = findexec("mplayer");
my $prog_mencoder  = findexec("mencoder");

################ The Process ################

use File::Spec;
use File::Path;
use File::Basename;
use Time::Local;
use Image::Info;
use Image::Magick;
use Data::Dumper;
use POSIX qw(locale_h strftime);
use locale;

# The files already there, if any.
my $gotlist = new FileList;
# The files in the import dir, if any.
my $implist = new FileList;

# The list of files, in the order to be processed.
# This list is initialy filled from info.dat, and (optionally) updated
# from the other lists.
my $filelist = new FileList;

# This is the list of all entries to be journalled (all images, plus
# possible interspersed loose annotations).
my @journal;

# Load cached info, if possible.
load_cache();

# Load image names and info from the info file, if any.
# This produces the initial file list.
load_info();
#print STDERR Data::Dumper->Dump([$filelist],[qw(filelist)]);

# Load image names and info for files we already got.
load_files()  if -d d_large();
#print STDERR Data::Dumper->Dump([$gotlist],[qw(gotlist)]);

# Load image names and info for files we can import.
load_import() if $import_dir && -d $import_dir;
#print STDERR Data::Dumper->Dump([$implist],[qw(implist)]);

# Apply defaults to unset parameters.
set_defaults();

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

# Verify and update the file list.
my $added = update_filelist();
#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_thumbnails(), d_medium()], $verbose > 1);
}
mkpath([d_large(), d_thumbnails(), d_icons(), d_css()], $verbose > 1);
mkpath([d_medium()], $verbose > 1) if $medium;

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

# Create the default style sheets, if necessary.
add_stylesheets();

script/album  view on Meta::CPAN

my @subdirs;

# Journal tags
my %jnltags;

# Note: the HTML generators use the file names relatively.
sub fjoin	 { File::Spec->catfile(@_); }
sub d_dest       { unshift(@_, $dest_dir) unless $dest_dir eq ".";
		   fjoin(@_); }
sub d_large      { unshift(@_, "large");      goto &d_dest; }
sub d_medium     { unshift(@_, "medium");     goto &d_dest; }
sub d_thumbnails { unshift(@_, "thumbnails"); goto &d_dest; }
sub d_journal    { unshift(@_, "journal");    goto &d_dest; }

sub d_destc      { unshift(@_, $lib_common) if $lib_common ne ""; 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;}

my %optcfg;			# option set from config files

sub setopt {
    no strict qw(refs);
    return if defined(${$_[0]});
    print STDERR ("setopt $_[0] -> $_[1]\n") if $trace;
    ${$_[0]} = $_[1];
    $optcfg{$_[0]} = 1;
}

sub parse_line {
    local ($_) = (@_);
    my $err = 0;

    if ( /^!?\s*(\S.*)/ ) {
	$_ = $1;
	if ( /^title\s+(.*)/ ) {
	    setopt("album_title", $1);
	}
	elsif ( /^page\s+(\d+)x(\d+)/ ) {
	    setopt("index_rows", $1);
	    setopt("index_columns", $2);
	}
	elsif ( /^thumbsize\s*(\d+)/ ) {
	    setopt("thumb", $1);
	}
	elsif ( /^mediumsize\s*(\d+)/ ) {
	    setopt("medium", $1);
	}
	elsif ( /^medium\s*(-?\d+)?/ ) {
	    setopt("medium", $1 || DEFAULTS->{mediumsize});
	}
	elsif ( /^dateformat\s*(.*)/ ) {
	    setopt("datefmt", $1);
	}
	elsif ( /^caption\s*(.*)/ ) {
	    setopt("caption", $1);
	}
	elsif ( /^icon\s*(.*)/ ) {
	    setopt("icon", defined($1) && length($1) ? $1 : 1);
	}
	elsif ( /^locale\s*(.*)/ ) {
	    setopt("locale", $1);
	}
	elsif ( /^depth\s+(\d+)/ ) {
	    # lib_common is used in the HTML, don't use fjoin.
	    setopt("lib_common", join("/", ("..") x $1));
	}
	else {
	    warn("Unknown control: $_[0]\n");
	    $err++;
	}
    }
    else {
	warn("Invalid control: $_[0]\n");
	$err++;
    }
    $err;
}

sub set_defaults {
    # Load settings from user files.
    my $sl;
    unless ( $sl = $ENV{ALBUMCONFIG} ) {
	$sl = ".albumrc";
	$sl .= ":".$ENV{HOME}."/.albumrc" if $ENV{HOME};
    }
    foreach my $cf ( split(/:/, $sl) ) {
	unless ( -f $cf ) {
	    warn("$cf: $!\n") if $ENV{ALBUMCONFIG};
	    next;
	}
	open(my $fh, "<$cf") || next;
	warn("parsing: $cf\n") if $trace;
	my $err = 0;
	while ( <$fh> ) {
	    next if /^\s*#/;
	    next unless /\S/;
	    $err += parse_line($_);
	}
	close($fh);
	die("Errors in config file $cf, aborted\n") if $err;
    }

    # Finally, apply defaults if necessary.
    warn("apply defaults\n") if $trace;
    setopt("album_title",   DEFAULTS->{title});
    setopt("index_rows",    DEFAULTS->{indexrows});
    setopt("index_columns", DEFAULTS->{indexcols});
    setopt("thumb",         DEFAULTS->{thumbsize});
    setopt("datefmt",       DEFAULTS->{dateformat});
    setopt("icon",          DEFAULTS->{icon});

    $medium = DEFAULTS->{mediumsize} if defined($medium) && !$medium || $mediumonly;
    $medium = 0 if defined($medium) && $medium < 0;

    # Caption values.
    setopt("caption", DEFAULTS->{( -s $info_file || $import_dir) ?
				 "caption" : "captionmin" });
    die("Invalid value for caption: $caption\n")
      unless $caption =~ /^[fsct]*$/i;
    $caption = lc($caption);

    if ( $locale ) {
	setlocale(LC_TIME, $locale);
	setlocale(LC_COLLATE, $locale);
    }

    if ( defined($lib_common) ) {
	$lib_common =~ s;/+$;;;
    }
    $lib_common ||= "";
}

sub load_info {
    my %typemap = ( 'p' => T_JPG, 'm' => T_MPG, 'v' => T_VOICE );

    # If an info has been supplied, it'd better exist.
    if ( $info_file ) {
	die("$info_file: $!\n") unless -s $info_file;
    }
    else {
	# Try default.
	$info_file = d_dest(DEFAULTS->{info});
	unless ( -s $info_file ) {
	    my $add_new; $add_new++ if $import_dir;
	    my $add_src; $add_src++ if -d d_large();
	    print STDERR ("No ", DEFAULTS->{info});
	    print STDERR (", adding images from ") if $add_src || $add_new;
	    print STDERR (d_large())               if $add_src;
	    print STDERR (" and ")                 if $add_src && $add_new;
	    print STDERR ($import_dir)             if $add_new;
	    print STDERR ("\n");
	    return;
	}
    }

    my $err = 0;
    my $file;
    my $tag;

    my $fh = do { local *FH; *FH };
    die("$info_file: $!\n")
      unless open($fh, $info_file);
    warn("parsing: $info_file\n") if $trace;

    my $el;
    my %dirs;

    while ( <$fh> ) {
	chomp;

	next if /^\s*#/;
	next unless /\S/;

	if ( /^\s+/ && $el ) {
	    $el->description($el->description . "\n" . $_);
	    next;
	}

	if ( /^!\s*(\S.*)/ ) {
	    $_ = $1;
	    if ( /^tag\s*(.*)/ ) {
		$tag = $1;
		$tag =~ s/\s$//;
		$tag =~ s/\s+/ /g;