locale results from the CPAN

Album

#!/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;^\./;;;
$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|nef|webp)};
my $movpat = qr{(?i:mpe?g|mov|avi|mp4|mts)};
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;

# Stylesheets version.
my $css_major = 1;
my $css_minor = 0;

# Formats version.
my $fmt_major = 1;
my $fmt_minor = 0;

# 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::ExifTool;
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();

# Perform selection. Normally, hidden entries are ignored.
# Option --select=all overrides this.
$filelist = $filelist->filter($select);

#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_index(), d_medium()], $verbose > 1);
    rmtree([d_journal()], $verbose > 1);
}
mkpath([d_index(), d_large(), d_icons()], $verbose > 1);
mkpath([d_medium()], $verbose > 1) if $medium;

script/album view on Meta::CPAN

sub hjoin	 { join("/", @_); }

# $fjoin will be dynamically switched depending on context.
our $fjoin; INIT { $fjoin = \&fjoin }

sub d_dest       { unshift(@_, $dest_dir) unless $dest_dir eq ".";
		   $fjoin->(@_); }
sub d_index      { unshift(@_, "index");      goto &d_dest; }
sub d_large      { unshift(@_, "large");      goto &d_dest; }
sub d_medium     { unshift(@_, "medium");     goto &d_dest; }
sub d_journal    { unshift(@_, "journal");    goto &d_dest; }
sub d_up	 { unshift(@_, "..");         goto &d_dest; }

sub d_destc      { unshift(@_, $lib_common) if $lib_common; 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);
	    $forcemedium = defined $2;
	}
	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));
	}
	elsif ( /^home\s+(.+)/ ) {
	    setopt("home_link", $1);
	}
	elsif ( /^skew\s+(.+)/ ) {
	    setopt("skew", $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 ", d_dest(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, "<:encoding(UTF-8)", $info_file);
    warn("parsing: $info_file\n") if $trace;

    my $el;
    my %dirs;

    while ( <$fh> ) {
	chomp;

	# Detection of condig system for info_file.
	# Uses GNU Emacs syntax, e.g.,
	#  # blah        -*- mode: album; coding: utf-8 -*-
	if ( $. == 1
	     &&
	     m/^\s*\#			# start with #
	      .*			# arb
	      -\*-			# -*-
	      (?:.*?;)*			# things, must be ; terminated
	      \s*			# ws
	      coding\s*:\s*([\w\d-]+)	# coding: utf-8
	      \s*			# ws
	      (?:;.*)*			# things, must be ; started
	      -\*-			# -*-

( run in 1.214 second using v1.01-cache-2.11-cpan-941387dca55 )