view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

# 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.

script/album  view on Meta::CPAN

    }

    my $iconfile = "icon.jpg";
    my $ii = cache_entry(" indexicon ");
    if ( -f $iconfile && $ii && $ii->dest_name eq "@imgs" ) {
	return 0;
    }
    my $el = new ImageInfo($iconfile);
    $el->dest_name("@imgs");
    cache_entry(" indexicon ", $el);
    $cache_update++;

    my $image = new Image::Magick->new;
    foreach ( @imgs ) {
	$image->Read($_);
    }

    my $width = $thumb;
    my $height = int($thumb*0.75);

    $image = $image->Montage(tile=>"${index_columns}x${index_rows}",
			     texture=>"xc:gray90");
    $image->Resize(geometry=>"${width}x${height}");
    $image->Write($iconfile);
    1;
}

################ Subroutines ################

sub app_options {
    my $help = 0;		# handled locally
    my $ident = 0;		# handled locally

    # Process options, if any.
    # Make sure defaults are set before returning!
    return unless @ARGV > 0;

    if ( !GetOptions(
	# Run time options.
	'clobber'        => \$clobber,
	'dcim=s'         => sub { $import_dir = $_[1]; $import_exif++ },
	'exif'           => \$import_exif,
	'import=s'       => \$import_dir,
	'info=s'         => \$info_file,
	'link!'          => \$linkthem,
	'update'         => \$update,
	'mediumonly'     => \$mediumonly,
	'extformats'	 => \$externalize_formats,

        # Album options. Can also be set in info/config files.
	'captions=s'     => \$caption,
	'cols|columns=i' => \$index_columns,
	'icon!'          => \$icon,
	'medium'         => sub { $medium = 0 },
	'mediumsize=i'   => \$medium,
	'rows=i'         => \$index_rows,
	'thumbsize=i'    => \$thumb,
	'title=s'        => \$album_title,

	# Miscellaneous.
	'debug'          => \$debug,
	'help|?'         => \$help,
	'ident'          => \$ident,
	'quiet'          => sub { $verbose = 0 },
	'test'           => \$test,
	'trace'          => \$trace,
	'verbose+'       => \$verbose,
        )
	 or $help
	 or @ARGV > 1
	 or @ARGV && ! -d $ARGV[0]
       )
    {
	app_usage(2);
    }

    app_ident() if $ident;
    $dest_dir = @ARGV ? shift(@ARGV) : ".";
    $dest_dir =~ s;^\./;;;
    if ( $import_dir ) {
	die("$import_dir: Not a directory\n")
	  unless -d $import_dir;
	$import_dir =~ s;^\./;;;
    }
}

sub app_ident {
    print STDERR ("This is $my_package [$my_name $my_version]\n");
}

sub app_usage {
    my ($exit) = @_;
    app_ident();
    print STDERR heredoc(<<"    EndOfUsage", 4);
    Usage: $0 [options] [ directory ]
      Album:
	--info XXX          description file, default "@{[DEFAULTS->{info}]}" (if it exists)
	--title XXX         album title, default "@{[DEFAULTS->{title}]}"
	--[no]icon          [do not] produce an album icon
      Index:
	--cols NN           number of columns per page, default @{[DEFAULTS->{indexcols}]}
	--rows NN           number of rows per page, default @{[DEFAULTS->{indexrows}]}
	--thumbsize NNN     the max size of thumbnail images, default @{[DEFAULTS->{thumbsize}]}
	--captions XXX      f: filename s: size c: description t: tag
      Medium:
	--medium            produce medium sized images of size @{[DEFAULTS->{mediumsize}]}
	--mediumsize NNN    the max size of medium sized images, default @{[DEFAULTS->{mediumsize}]}
	--mediumonly        ignore large images and links (for web export)
      Importing:
	--import XXX        original images
	--exif              use w/ EXIF info, if possible
	--dcim XXX          as --import with --exif
	--update            add new entries from import, if needed
	--[no]link          [do not] link to original, instead of copying. Default is link.
      Miscellaneous:
	--clobber           recreate everything (except large)
	--test              verify only
	--help              this message
	--ident             show identification
	--verbose           verbose information
    EndOfUsage