Mkphotohtml Ver.1.0 (BIN)
山田邦博です。
Mkphothhtml の投稿です。
ディジタルカメラ(Digital Camera)で多量に撮った写真を簡単に整理し、
Netscape や Mozilla 等の一般的なブラウザ(Web browser) で見れるようにする
ものです。
Unix ユーザ(Unix user)向けです。
詳細は先の投稿の DOC を参照して下さい。
-...-
本投稿は 2部に分けて投稿します。
DOC (先の投稿、ドキュメント部)
BIN (今回投稿分、shar のため長大です)
-...-
Mkphotohtml Ver.1.0 の全てのファイルは
ftp://ftp.tksa.gr.jp/king/image/Mkphotohtml_1.0.tgz
にあります。
最新の Mkphotohtml (ドキュメントを含む)については
http://www.tksa.gr.jp/king/Software/Mkphotohtml/index.html
を参照して下さい。
そこに実例も示しておきました。
-...-
インストール方法は下記 shar より、mkphotohtml を取り出し、以下の PATH
の通っている所にコピーして下さい。
/usr/local/bin/, /usr/bin/ あるいは $HOME/bin/ 等
または、上記 FTP より Mkphotohtml_1.0.tgz を取って来て、展開、その中の
installer を以下のように実行して下さい。
# Mkphotohtml_1.0/bin/install.sh local
## local は usr あるいは home も可。
詳細は同アーカイブ中のドキュメントを参照して下さい。
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.2.1).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 2003-07-30 23:42 JST by <king@owlin>.
# Source directory was `/home/king/tmp/Mkphotohtml_1.0'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 48884 -rwxr-xr-x bin/mkphotohtml
#
save_IFS="${IFS}"
IFS="${IFS}:"
gettext_dir=FAILED
locale_dir=FAILED
first_param="$1"
for dir in $PATH
do
if test "$gettext_dir" = FAILED && test -f $dir/gettext \
&& ($dir/gettext --version >/dev/null 2>&1)
then
set `$dir/gettext --version 2>&1`
if test "$3" = GNU
then
gettext_dir=$dir
fi
fi
if test "$locale_dir" = FAILED && test -f $dir/shar \
&& ($dir/shar --print-text-domain-dir >/dev/null 2>&1)
then
locale_dir=`$dir/shar --print-text-domain-dir`
fi
done
IFS="$save_IFS"
if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED
then
echo=echo
else
TEXTDOMAINDIR=$locale_dir
export TEXTDOMAINDIR
TEXTDOMAIN=sharutils
export TEXTDOMAIN
echo="$gettext_dir/gettext -s"
fi
if touch -am -t 200112312359.59 $$.touch >/dev/null 2>&1 && test ! -f 200112312359.59 -a -f $$.touch; then
shar_touch='touch -am -t $1$2$3$4$5$6.$7 "$8"'
elif touch -am 123123592001.59 $$.touch >/dev/null 2>&1 && test ! -f 123123592001.59 -a ! -f 123123592001.5 -a -f $$.touch; then
shar_touch='touch -am $3$4$5$6$1$2.$7 "$8"'
elif touch -am 1231235901 $$.touch >/dev/null 2>&1 && test ! -f 1231235901 -a -f $$.touch; then
shar_touch='touch -am $3$4$5$6$2 "$8"'
else
shar_touch=:
echo
$echo 'WARNING: not restoring timestamps. Consider getting and'
$echo "installing GNU \`touch', distributed in GNU File Utilities..."
echo
fi
rm -f 200112312359.59 123123592001.59 123123592001.5 1231235901 $$.touch
#
if mkdir _sh05420; then
$echo 'x -' 'creating lock directory'
else
$echo 'failed to create lock directory'
exit 1
fi
# ============= bin/mkphotohtml ==============
if test ! -d 'bin'; then
$echo 'x -' 'creating directory' 'bin'
mkdir 'bin'
fi
if test -f 'bin/mkphotohtml' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'bin/mkphotohtml' '(file already exists)'
else
$echo 'x -' extracting 'bin/mkphotohtml' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'bin/mkphotohtml' &&
#! /usr/bin/perl -w
X
# mkphotohtml : Make photo.html
#
X
# Author:
# YAMADA Kunihiro <king@tksa.gr.jp>
# (http://www.tksa.gr.jp/king/)
#
# Copyright policy:
# GNU GPL Ver.2
#
X
# Usage:
# mkphtohtml [option] [directories ...]
# Options:
# -b : Back button added to photo.html (Default: Not added)
# -c : Clean bogus shrinked images
# -D : Debug
# -e : English (same as -o Language=English)
# -f : Force update
# -h : Help
# -m mailaddress :
# Mail address like as 'yourid@your.domain'
# (same as -o Mail-Address=yourid@your.domain)
# -n : use external programme "nkf" for Language=Japanese
# (same as -o Nkf=Use)
# -o : Default theme options for Contents.conf:
# There are many sub options.
# The format is "Sub-Option=value,...."
# Type "mkphothtml -h: for detail theme options,
# or read README.jp.txt for more detail
# -r : Recursive
# -u Username :
# Full name of user like as "Firstname Lastname"
# (same as -o "User-Name=Firstname Lastname")
# -v : Verbose messages
#
# Directories:
# Directory list of the themes. (Default : current directory(.))
#
X
# Documents:
# Following documents are available;
# BUGS.jp.txt
# Change.log
# Format.txt
# INSTALL.jp.txt
# MUMBLE.jp.txt
# README.jp.txt (Japanese text only, sorry)
#
X
# Latest version:
# You can get the latest version and it's documents from
# my web page;
# http://www.tksa.gr.jp/king/Software/Mkphothtml/
#
X
# History:
# (Please see other document "Change.log" for detail.)
# 28 Dec.2000 starting Ver.0.0
# 11 Apr.2001 Ver.0.0
# 9 Jun.2003 starting Ver.1.0
# 21 Jun.2003 rewrite almost
# 22 Jul.2003 Ver.1.0-pre.1 : Released
# 29 Jul.2003 Ver.1.0 : Released
#
X
no lib qw(:ALL .);
use strict qw(vars subs refs);
use Getopt::Std;
use Cwd;
use File::Basename;
use Time::localtime;
use File::stat;
use IPC::Open2;
use vars qw($opt_b $opt_c $opt_D $opt_e $opt_f $opt_h $opt_m
X $opt_n $opt_o $opt_r $opt_u $opt_v);
X
die "$0 : \"Root user or group\" is prohibitted, sorry.\n"
X if $< == 0 or $> == 0 or $( == 0 or $) == 0; # uid,euid,gid,egid : root?
X
#######################################
### Please configure for your needs ###
#######################################
X
umask 022;
my $DMODE = 0755; # Permission for directory
my $CONFIG = "Contents.conf"; # Configure file for contents
my $CONTENT = "Contents.db"; # Contents file (generated)
my $HTML = "photo.html"; # HTML file (generated)
my $IMGEXT = "jpeg|JPEG|jpg|JPG"; # Extention of Image file
my $ORIG = "ORIG"; # Extention of Original image file
X
## program path ##
my $NKF = "/usr/bin/nkf"; # program for code conversion (Japanese)
my $DJPEG = "/usr/bin/djpeg"; # decompress a JPEG file to an image file
my $CJPEG = "/usr/bin/cjpeg"; # compress an image file to a JPEG file
my $JPEGTOPNM = "/usr/bin/jpegtopnm -quiet";
X # convert JFIF file to portable pixmap
my $PNMSCALE = "/usr/bin/pnmscale"; # scale a PNM image
my $PNMTOJPEG = "/usr/bin/pnmtojpeg"; # convert PNM image to a JFIF image
my $HOSTNAME = "/bin/hostname"; # show or set the system's host name
X
## default for option -o ##
## These options can be changed by option -o or system and user option file,
## and can be overlayed temporaly by $CONFIG file on each theme directory.
## Caution: These default options are not checked these validity,
## so take care when you change these default values!
## System wide options (/etc/mkphotohtml/option) are recommended.
##
$::opt_order = "New-First"; # , New-Last, Theme-First or Image-First
$::opt_image = "Reverse"; # or Normal
$::opt_theme = "Reverse"; # or Normal
$::opt_config = "Non"; # , First or Last
$::opt_lang = "Japanese"; # or English
$::opt_messagefile = ""; # Name of Message File (Default: nothing)
$::opt_usenkf = "Non"; # or Use
$::opt_mail = '$userid@$domain'; # your mail address
$::opt_uname = '$passwd'; # your name like as "First Middle Last"
$::opt_scale = "(1/1=:raw)(1/2=:shrink)(1/4=:shrink)(1/8=:shrink)";
X # Scale and Directory name for raw and shrinked pictures
$::opt_size = "(Normal=1/2)(Header=1/4)(Index=1/8)";
X # Size of Picture for Normal, Header and Indicies display
X
## Messages for HTML with multi lingual.
## These messages can be changed by option -o MessageFile=filepath.
## See file "message.sample.english" and "message.sample.japanese".
## Caution: These default messages are not checked these validity,
## so take care when you change these default values!
## System wide messages (/etc/mkphotohtml/message.*) are recommended.
##
%::html_charset = ("English" =>"iso-8859-1",
X "Japanese"=>"iso-2022-jp");
%::html_album = ("English" =>"Photographic Album",
X "Japanese"=>"\x1b\$B<L??=8\x1b(B");
%::html_comment = ("English" =>"Click a photo to enlarge or go to sub-theme.",
X "Japanese"=>
X "\x1b\$B3(\$r%/%j%C%/\$9\$k\$H3HBg\$^\$?\$O%5%V%F!<%^\$K\$J\$j\$^\$9!#\x1b(B"
X );
%::html_theme = ("English" =>"Theme: ",
X "Japanese"=>"\x1b\$B%F!<%^!'\x1b(B");
%::html_latest = ("English" =>"Latest: ",
X "Japanese"=>"\x1b\$B:G?7!'\x1b(B");
%::html_arrow = ("English" =>'->',
X "Japanese"=>"\x1b\$B\"*\x1b(B");
%::html_back = ("English" =>"BACK",
X "Japanese"=>"\x1b\$BLa\$k\x1b(B");
X
#############################
### End of Configuration ###
#############################
X
X
### Constants ###
my $VERSION = "1.0";
my $WEBINFO = "http://www.tksa.gr.jp/king/Software/Mkphothtml/";
X
my $PFIRST = "[-_]?(First|1st|Fir)";
my $PLAST = "[-_]?Last?";
my $PTHEME = "The(m[ea]?)?";
my $PDIR = "Dir(ectory)?";
my $PIMAGE = "Ima(ge)?";
my $PNAME = basename $0;
my $LPNAME = $PNAME; $LPNAME =~ tr/a-z/A-Z/;
X
### Global valiables ###
my $picrawdir; # Directory name for raw images
my %scale_dir; # Scale-Directory
my %picheader; # Picture(Header,Index,Norml)-Scale
my %shrink_name; # shrink name(extention) inserted into image file name
my @sorted_scale; # Sorted scale of Pictures
my %version_checked;
X
my ($BUTTON,$CLEAN,$DEBUG,$FORCEUPDATE,$HELP,$RECURSIVE,$VERBOSE);
X
getopts('bcDefhm:no:ru:v');
$BUTTON = $opt_b;
$CLEAN = $opt_c;
$DEBUG = $opt_D;
$FORCEUPDATE = $opt_f;
$HELP = $opt_h;
$RECURSIVE = $opt_r;
$VERBOSE = $opt_v;
X
sub change_to_jis ( $ );
sub set_option_from_file ( $;$ );
sub set_option ( $$;$ );
sub set_messages ( $ );
sub change_to_jis ( $ );
sub check_version ( $$ );
sub makephoto (@);
X
foreach my $f (glob "/etc/$PNAME/message.*") {
X next unless $f =~ m!/message\.\w+$!;
X next unless -r $f;
X set_messages($f); # read system Message-File
X warn <<EOF if $VERBOSE;
System message file($f) is read.
X Default messages are added or replaced.
EOF
}
X
if (-r "/etc/$PNAME/option") {
X set_option_from_file("/etc/$PNAME/option"); # System wide options
X warn <<EOF if $VERBOSE;
System wide option file "/etc/$PNAME/option" is read.
X Default theme-options are override.
EOF
}
X
if ($HELP) {
X my $langs = join ",",sort keys %::html_charset;
X $langs =~ s/,([^,]*)$/ and $1/;
X print <<EOF;
X
This is Mkphotohtml version $VERSION
X
Copyright 2001-2003, YAMADA Kunihiro <king\@tksa.gr.jp>
X
You can get the latest version from
\t$WEBINFO
X
X
Usage: $PNAME [option] [directories ...]
X
Options:
X -b : Back button added to photo.html (Default: Not added)
X -c : Clean up bogus shrinked images
X -D : Debug
X -e : English (same as -o Language=English)
X -f : Force update
X -h : Help
X -m mailaddress :
X Mail address like as 'yourid\@your.domain'
X (same as -o Mail-Address=yourid\@your.domain)
X -n : use external programme "nkf" for Language=Japanese
X (same as -o Nkf=Use)
X -o : Default theme options for $CONFIG:
X Order=New-First|New-Last|Theme-First|Image-First (Default : $::opt_order)
X Image=Reverse|Normal (Default : $::opt_image)
X Theme=Reverse|Normal (Default : $::opt_theme)
X Config=Non|First|Last (Default : $::opt_config)
X Language=Japanese|English (Default : $::opt_lang)
X Note: You can specify any language if you prepared a proper
X message file.
X By default messages in this script, only Japanese or
X English can be specified.
X Message-File=path-name-of-the-message-file (Default : Nothing)
X Nkf=Non|Use (Default : Non)
X Mail-Address=yourid\@your.domain (Default : $::opt_mail)
X User-Name="FirstName LastName" (Default : $::opt_uname)
X Scale-Directory=(scale1=directory1)(scale2=directory2)....
X (Scale and Directory name for raw and shrinked pictures)
X Default : $::opt_scale
X Size-of-Picture=(display1=scale1)(display2=scale2)....
X (Size of Picture for Normal, Header and Indices display)
X Default : $::opt_size
X -r : Recursive
X -u username :
X Full name of user like as "Firstname Lastname"
X (same as -o "User-Name=Firstname Lastname")
X -v : Verbose messages
X
Directories:
X Directory list of the themes. (Default : current directory(.))
X
Current usable languages by system defaults are
\t$langs.
X
EOF
X exit 0;
}
X
my $conf_dir;
if (-d "$ENV{HOME}/etc/$PNAME") {
X $conf_dir = "$ENV{HOME}/etc/$PNAME"; # User options/messages
} elsif (-d "$ENV{HOME}/.$PNAME") {
X $conf_dir = "$ENV{HOME}/.$PNAME"; # Alternate user options/messages
}
warn "\"$conf_dir\" is used for user defined defaults.\n"
X if $VERBOSE and $conf_dir;
X
if ($conf_dir) {
X foreach my $f (glob "$conf_dir/message.*") {
X next unless $f =~ m!/message\.\w+$!;
X next unless -r $f;
X set_messages($f); # read user Message-File
X warn <<EOF if $VERBOSE;
User message file($f) is read.
X Default messages are added or replaced.
EOF
X }
}
X
if ($conf_dir and -r "$conf_dir/option") {
X set_option_from_file("$conf_dir/option"); # User options
X warn <<EOF if $VERBOSE;
User theme options are set by "$conf_dir/option".
X Default theme-options are override.
EOF
}
X
if (exists $ENV{$LPNAME}) {
X foreach (split m/,/,$ENV{$LPNAME}) {
X set_option("ENV",$_); # Options from Enviroment
X warn <<EOF if $VERBOSE;
Theme options are set by the environment "$LPNAME".
X Default theme-options are override.
EOF
X }
}
X
$::opt_lang = "English" if $opt_e;
$::opt_mail = $opt_m if $opt_m; # Mail address
if ($opt_m) {
X die <<EOF unless $opt_m =~ /\@/;
Bad option: "-m $opt_m" : should be included "\@".
EOF
}
$::opt_usenkf = "Use" if $opt_n;
$::opt_uname = $opt_u if $opt_u; # User Name
if ($opt_o) { # Option -o (from sh command)
X foreach (split m/,/,$opt_o) {
X set_option("sh",$_);
X }
X warn <<EOF if $VERBOSE;
Theme options are set by the shell command option "-o".
X Default theme-options are override.
EOF
}
X
unshift @ARGV, "." unless @ARGV; # add default directory to current
X
makephoto(@ARGV);
Xexit 0;
X
######################################################################
X
my $ILN; # Input Line Number
X
sub get_config ( \*;$$ ) {
X my ($in,$lang,$usenkf) = @_;
X my $change_code = ($usenkf and $usenkf eq "Use" and
X $lang and $lang eq "Japanese");
X local (*FH) = $$in;
X local ($_);
X return "" if eof(FH);
X while (<FH>) {
X $ILN = $.;
X chomp;
# print "#",__LINE__,"# $.: \"$_\"\n" if $DEBUG;
X next if /^\s*$/; # Null line
X next if /^\s*\#/; # line with only comment
X s/^\s+/\t/; # replace preceding spaces with single tab
X s/\s+$//; # remove trailing spaces
X s/\s+\#.*//; # remove comment part
X $_ = change_to_jis($_) if $change_code; # change code to 7bit jis
X return $_;
X }
X return "";
}
X
sub check_scale ( $ ) {
X my $scale = shift;
X my $v = 0;
X my $mes;
X if ($scale =~ /^(\d+)$/) {
X $v = $1;
X } elsif ($scale =~ /^(\d*)\.(\d*)$/) {
X $v = (($1 or $2) ? $scale + 0 : 0);
X } elsif ($scale =~ m!^(\d+)/(\d+)$!) {
X if ($2) {
X $v = $1 / $2;
X } else {
X $mes = "Bad scale value($scale) : cannot divide by 0.";
X }
X } else {
X $mes = "Bad scale format \"$scale\".";
X }
X if (not $mes and ($v > 1 or $v ==0)) {
X $mes = "Bad scale value($v): should be >0 and <=1.";
X }
X return ($v,$mes);
}
X
sub set_option_from_file ( $;$ ) {
X my $file = shift;
X my $only_scale_size = shift;
X print "#",__LINE__,"# set_option_from_file, (",cwd,")($file) ",($only_scale_size?"ONLY":"ALL"),"\n" if $DEBUG;
X open(INF,"<$file") || die "Cannot open file $file : $!";
X my $from = "conf";
X $from = "db" if $file =~ /$CONTENT$/;
X $from = "$file" if $file =~ m!/!;
X OUTER:
X while ($_ = get_config(*INF,$::opt_lang,$::opt_nkf)) {
X if (/^Ver(sion)?:/i) {
X if ($_ = get_config(*INF,$::opt_lang,$::opt_nkf)) {
X check_version($file,$_);
X }
X } elsif (/^Opt(ion)?:$/i) {
X while ($_ = get_config(*INF,$::opt_lang,$::opt_nkf)) {
X last OUTER if /^\S/;
X set_option($from,$_,$only_scale_size);
X }
X }
X }
X close(INF);
}
X
sub set_option ( $$;$ ) {
X my $from = shift;
X local $_ = shift;
X my $only_scale_size = shift;
# print "#",__LINE__,"# set_option from='$from' \$_='$_'\n" if $DEBUG;
X s/^\s+//;
X s/\s+$//;
X my $errmes;
X if ($from eq "conf") {
X $errmes = "Error at " . cwd() . "/$CONFIG line $ILN :";
X } elsif ($from eq "db") {
X $errmes = "Error at " . cwd() . "/$CONTENT line $ILN :";
X } elsif ($from eq "sh") {
X $errmes = "Error in \"-o option\" on shell command:";
X } elsif ($from eq "ENV") {
X $errmes = "Error in Environment \"$LPNAME\":";
X } else { # Contents.db or mkphotohtml.conf
X $errmes = "Error at $from line $ILN:";
X }
X
X if (s/Sca(le)?([-_]?($PDIR)?)?=\s*//io) {
X s/\s+//g;
X $::opt_scale = $_;
X $::opt_size = ""; # option_size should be set later
X my %vlist;
X while (s/^\((.*?)\)//) {
X my $s = $1;
X unless ($s =~ /(.*)=(.*)/) {
X die <<EOF;
$errmes
\t"Scale-Directory=" should be formed as "(Scale=Directory)".
EOF
X }
X my ($scale,$dir) = ($1,$2);
X my ($v,$mes) = check_scale($1);
X die <<EOF if $mes;
$errmes
\t"Scale-Directory=" ($s)
\t\t$mes
EOF
X die <<EOF if exists $vlist{$v};
$errmes
\t"Scale-Directory=($s)" :
\t\tThe value($v) of the scale($scale) is doubly defined.
EOF
X $vlist{$v} = $dir;
X }
X die <<EOF if $_;
$errmes
\t"Scale-Directory=" : Bad format.
EOF
X die <<EOF unless exists $vlist{1};
$errmes
\t"Scale-Directory=" should be specified the raw image directory that
\t the value of scale is 1.
EOF
X my $c1 = substr($vlist{1},0,1); # 1st character of image directory name
X for my $v (keys %vlist) {
X my $cx = substr($vlist{$v},0,1);
X die <<EOF unless $c1 eq $cx;
$errmes
\t"Scale-Directory=$::opt_scale" :
\t First character of directory name should be same.
\t (First character of raw image directory is "$c1", but
\t the one of scale of $v is "$cx".)
EOF
X }
X } elsif (s/Size?([-_]?(of[-_]?)?Pic(ture)?)?=\s*//i) {
X s/\s+//g;
X my ($h,$i,$n);
X while (s/^\(.+?\)//) {
X my $s = $&;
X if ($s =~ /\((.*?)=(.*?)\)/) {
X my $picture = $1;
X my $scale = $2;
X unless ($picture =~
X /^Nor(mal)?$|^N$|^Hea(der)?$|^H$|^Ind(ex)?$|^Indices$|^I$/i) {
X die <<EOF;
$errmes
\t"Size-of-Picture=" should be formed as "(Display=Scale)".
\t\t(Display=Scale)=($picture=$scale) : Bad Display specified.
\t\t\tDisplay is one of "Normal", "Header" and "Index".
EOF
X }
X die <<EOF unless $::opt_scale =~ /\($scale=/;
$errmes
\tOption: Size-of-Picture=($picture=$scale)
\t Scale($scale) not found on Scale-Directory.
EOF
X $h = $scale if $picture =~ /^H/i;
X $i = $scale if $picture =~ /^I/i;
X $n = $scale if $picture =~ /^N/i;
X }
X }
X die <<EOF if $_;
$errmes
\t"Size-of-Picture='$_'" : Bad format.
EOF
X die <<EOF unless $h and $i and $n;
$errmes
\t"Size-of-Picture=" should have Normal,Header and Index.
EOF
X $::opt_size = "(Normal=$n)(Header=$h)(Index=$i)";
# print "#",__LINE__,"# option_size='$::opt_size'\n" if $DEBUG;
X } elsif ($only_scale_size) { # truncate here if only scale size
X return;
X } elsif (s/^(Lan(guage)?|Lang)=\s*//i) {
X if (/^Japan(ese)?$|^JP$/i) {
X $::opt_lang = "Japanese";
X } elsif (/^Eng(lish)?$|^EN$/i) {
X $::opt_lang = "English";
X } else {
X my $lang;
X tr/a-z/A-Z/;
X foreach my $x (keys %::html_charset) {
X my $cx = $x;
X $cx =~ tr/a-z/A-Z/;
X if ($_ eq $cx) {
X $lang = $x;
X last;
X }
X if ($cx =~ /^(...)/) { # First 3 characters for abbr.
X if ($_ eq $1) {
X $lang = $x;
X last;
X }
X }
X }
X unless ($lang) {
X my @languages = keys %::html_charset;
X die <<EOF;
$errmes
\t"Option: Language=" should be one of (@languages).
EOF
X }
X $::opt_lang = $lang;
X }
X } elsif (s/^Ord(er)?=\s*//i) {
X if (/^New$PFIRST$|^Old$PLAST$/io) {
X $::opt_order = "New-First";
X } elsif (/^New$PLAST$|^Old$PFIRST$/io) {
X $::opt_order = "New-Last";
X } elsif (/^$PTHEME$PFIRST$|^$PDIR$PFIRST$|^$PIMAGE$PLAST$/io) {
X $::opt_order = "Theme-First";
X } elsif (/^$PIMAGE$PFIRST$|^$PTHEME$PLAST$|^$PDIR$PLAST$/io) {
X $::opt_order = "Image-First";
X } else {
X die <<EOF;
$errmes
\t"Option: Order=" should be New-First (Old-Last)
\t or New_Last (New-First)
\t or Theme-First (Image-Last)
\t or Image-First (Theme-Last)
EOF
X }
X } elsif (s/$PIMAGE=\s*//i) {
X if (/^Nor(mal)?$/i) {
X $::opt_image = "Normal";
X } elsif (/^Rev(erse)?$/i) {
X $::opt_image = "Reverse";
X } else {
X die <<EOF;
$errmes
\t"Option: Image=" should be "Normal" or "Reverse"
EOF
X }
X } elsif (s/($PTHEME|$PDIR)=\s*//io) {
X if (/^Nor(mal)?$/i) {
X $::opt_theme = "Normal";
X } elsif (/^Rev(erse)?$/i) {
X $::opt_theme = "Reverse";
X } else {
X die <<EOF;
$errmes
\t"Option: Theme=" should be "Reverse" or "Normal"
EOF
X }
X } elsif (s/Con(fig)?=\s*//i) {
X if (/^Non$/i) {
X $::opt_config = "Non";
X } elsif (/^(First|1st|Fir)$/i) {
X $::opt_config = "First";
X } elsif (/^Last?$/i) {
X $::opt_config = "Last";
X } else {
X die <<EOF;
$errmes
\t"Option: Config=" should be "Non" or "Normal" or "Reverse"
EOF
X }
X } elsif (s/^Mes(sage)?([-_]?File?)?=\s*//i) {
X my $msgfile = $_;
X set_messages($_);
X $::opt_messagefile = $msgfile if $from eq "conf";
X } elsif (s/Nkf=\s*//i) {
X if (/^Use$/i) {
X $::opt_usenkf = "Use";
X } elsif (/^No[nt]?$/i) {
X $::opt_usenkf = "Non";
X } else {
X die <<EOF;
$errmes
\t"Option: Nkf=" should be "Use" or "Non"
EOF
X }
X } elsif (s/^Mail?([-_]?Add(ress)?)?=\s*//i) {
X $::opt_mail = $_;
X die <<EOF unless /\@/;
$errmes
\t"Option: Mail=$_" : should be included "\@".
EOF
X } elsif (s/User?([-_]?Name?)?=\s*//i) {
X $::opt_uname = $_; # Name of User
X } elsif (/^$/) {
X # skip
X } else {
X die <<EOF;
$errmes
\tOption: "$_" is bad theme option.
EOF
X }
} # end of set_option
X
sub change_to_jis ( $ ) {
X my $s = shift;
X die "$NKF : cannot be executed.\n" unless -x $NKF;
X open2(\*INJ,\*OUTJ,$NKF,"-j"); # change code to 7bit jis
X print OUTJ $s;
X close(OUTJ);
X local $/ = "";
X $s = <INJ>;
X close(INJ);
X return $s;
}
X
sub set_messages ( $ ) {
X my $msgfile = shift;
X $msgfile =~ s/^\s+//;
X $msgfile =~ s/\s+$//;
X return unless $msgfile;
X my ($lang,$charset,$album,$comment,$theme,$latest,$arrow);
X my $back = "";
X die "\"$msgfile\" : Bad message file name.\n" unless $msgfile =~ /^[\/.\w]/;
X $msgfile = cwd . "/$msgfile" unless $msgfile =~ m!^/!;
X open(IN,"<$msgfile") || die "Cannot open Message-File \"$msgfile\" : $!";
X while ($_ = get_config(*IN)) {
# print "#",__LINE__,"# title: \"$_\"\n" if $DEBUG;
X if (/^\w+:$/i) {
X my $tl = $&;
X my $item;
X while ($_ = get_config(*IN)) {
# print "#",__LINE__,"# item: \"$_\"\n" if $DEBUG;
X last unless s/^\s+//;
X s/\"$// if s/^\"//; # remove quote
X die <<EOF if $item;
Error at $msgfile line $ILN :
\tItem for $tl should be a single line.
EOF
X $item = $_;
X }
X die <<EOF unless $item;
Error at $msgfile line $ILN :
\tNo item for $tl found.
EOF
X if ($tl =~ /^Lan(guage)?:$/i) {
X $item =~ /^(.)(.*)/;
X my ($f,$t) = ($1,$2);
X $f =~ tr/a-z/A-Z/;
X $t =~ tr/A-Z/a-z/;
X $lang = "$f$t";
X } elsif ($tl =~ /^Cha(rset)?:$/i) {
X $charset = $item;
X } elsif ($tl =~ /^Alb(um)?:$/i) {
X $album = $item;
X } elsif ($tl =~ /^Com(ment)?:$/i) {
X $comment = $item;
X } elsif ($tl =~ /^The(me)?:$/i) {
X $theme = $item;
X } elsif ($tl =~ /^Lat(est)?:$/i) {
X $latest = $item;
X } elsif ($tl =~ /^Arr(ow)?:$/i) {
X $arrow = $item;
X } elsif ($tl =~ /^Back?:$/i) {
X $back = $item;
X } else {
X die "Bad title ($tl) : at message file \"$msgfile\" line $ILN.\n";
X }
X redo;
X } elsif (/^$/) {
X last;
X } else {
X die "Title not found ($_) : at message file \"$msgfile\" line $ILN.\n";
X }
X }
X close(IN);
X die "Some title and item not defined in message file \"$msgfile\"\n"
X unless $lang and $charset and $album and $comment and
X $theme and $latest and $arrow;
X $::html_charset{$lang} = $charset;
X $::html_album{$lang} = $album;
X $::html_comment{$lang} = $comment;
X $::html_theme{$lang} = $theme;
X $::html_latest{$lang} = $latest;
X $::html_arrow{$lang} = $arrow;
X $::html_back{$lang} = $back;
} # end of set_messages
X
sub get_mtime_of_original_file ( $ ) {
X my $f = shift;
X unless ($f =~ /(.*\/)?(.+)\.($IMGEXT)/) {
X die "!!BUG!! $f : Bad image extension : ";
X }
X my $path = ($1 ? "$1$picrawdir" : $picrawdir);
X my $fname = $2;
X my $ext = $3;
X unless (-r "$path/$f") {
X print "#",__LINE__,"# no file: \"$path/$f\" \n" if $DEBUG;
X return undef;
X }
X my $f_orig;
X if ( -r "$path/$fname.$ORIG.$ext") {
X $f_orig = "$fname.$ORIG.$ext";
X } elsif (-r "$path/$fname.$ext.$ORIG") {
X $f_orig = "$fname.$ext.$ORIG";
X } else {
X $f_orig = "$fname.$ext";
X }
X return stat("$path/$f_orig")->mtime;
}
X
sub get_default_theme ( ;$ ) {
X my $fullpath = shift;
X local ($_) = (defined $fullpath ? $fullpath : cwd);
X s!/$!!; # remove last "/"
X s!.*/!!; # remove leading path
X $_ = "root" unless $_;
X return $_;
}
X
sub n_version ( $ ) {
X my $ver = shift;
X unless ($ver =~ /^(\d+)\.(\d+)(-[a-z][.\w]*)?$/i) {
X die "!!BUG!! bad version format : $!";
X }
X return $1+$2/1000;
}
X
sub check_version ( $$ ) {
X my ($file,$pname_version) = @_;
X $file = cwd . "/$file" unless $file =~ m!/!;
X my $db = ($file =~ /\.db$/ ? 1 : 0);
X my $recommended = ($db ? "\"$PNAME -fr\" is recommended."
X : "Config-file should be corrected.");
X my $version;
X if ($pname_version =~ /^\s+(\S+)\s+(\d+)\.(\d+)(-[a-z][.\w]*)?$/) {
X $version = "$2.$3";
X $version .= $4 if $4;
X die <<EOF unless $1 eq $PNAME;
Mismatched program!
X This program is "$PNAME".
X The specified program at $file line $ILN
X is "$1".
$recommended.
EOF
X my ($nV,$nv) = (n_version($VERSION),n_version($version));
X die <<EOF unless int($nV) == int($nv) and $nV >= $nv;
Mismatched version!
X The version of $PNAME
X is "$VERSION".
X The version at $file line $ILN
X is "$version".
$recommended.
EOF
X warn <<EOF if $VERSION ne $version and not exists $version_checked{$file};
X
Versions of $PNAME ($VERSION)
X and of $file line $ILN ($version)
are not exactly same, but accepted.
$recommended.
X
EOF
X } else {
X s/^\s+//;
X die <<EOF;
Improper version format ($_) is detected.
\tat $file line $ILN.
$recommended
EOF
X }
X $version_checked{$file} = 1;
X return $version;
}
X
X
sub getTheme ( $ ) {
X my $file = shift; # Contents-File
X local $_;
# my $lang = "English";
X print "#",__LINE__,"# getTheme($file)\n" if $DEBUG;
X my ($version,$theme,$image,$comment,$mtime);
X open(CF,"$file") || die "Cannot open $file : $!";
X SECTION:
X while ($_ = get_config(*CF)) {
X if (/^Option:/) {
X while ($_ = get_config(*CF)) {
X redo SECTION if /^\S/; # Skip Option: section
X }
X } elsif (/^Version:/) {
X if ($_ = get_config(*CF)) {
X $version = check_version($file,$_);
X }
X } elsif (/^Theme:/) {
X while($_ = get_config(*CF)) {
X if (/^\s+Theme=(.*)/) {
X $theme = $1;
X } elsif (/^\s+Image=(.*)/) {
X $image = $1;
X } elsif (s/^\s+Comment=//) {
X s/^\s+//;
X $comment = "$_";
X while ($_ = get_config(*CF)) {
X last if /^\S|^\s+[\w\.-]+=/;
X s/^\s+//;
X $comment .= "\n\t\t$_";
X }
X redo;
X } elsif (/^\s+Latest=(\d+)/) {
X $mtime = $1;
X } elsif (/^\S|^$/) {
X last;
X } else {
X die <<EOF;
Broken contents-file:
\tat $file line $ILN.
"$PNAME -fr" is recommended.
EOF
X }
X }
X }
X last if $version and $theme;
X }
X close(CF);
# print "#",__LINE__,"# getTheme result : $version,$theme,$image,$comment,$mtime\n" if $DEBUG;
X die <<EOF unless $version;
Version is not found in the contents-file. (It may be old.):
\t$file
"$PNAME -fr" is recommended.
EOF
X die <<EOF unless $theme and $image and $mtime;
"Theme:" section on the contents-file (as following) is broken.
\t$file
"$PNAME -fr" is recommended.
EOF
X return ($theme,$image,$comment,$mtime);
} # end of getTheme
X
sub get_shrink_size () {
# print "#",__LINE__,"# get_shrink_size\n" if $DEBUG;
X local $_ = $::opt_scale;
X die "!!BUG!! \"Option: Scale-Directory=\" is not set.\n" unless $_;
X %scale_dir = ();
X while (s/^\((.*?)\)//) {
X my $s = $1;
X if ($s =~ /(.*)=(.*)/) {
X my $scale = $1;
X my $dir = $2;
X $scale_dir{$scale} = $dir;
X } else {
X die <<EOF;
\t"Option: Scale-Directory=" should be formed as "(Scale=Directory)".
EOF
X }
X }
X die "Bad format.\n" if $_;
X $_ = $::opt_size;
X die <<EOF unless $_;
"Option: Size-of-Picture=" is not set.
\tNote: "Size-of-Picture" should be placed after "Scale-Directory"
EOF
X %picheader = ();
X while (s/^\((.*?)\)//) {
X my $s = $1;
X if ($s =~ /(.*)=(.*)/) {
X my $picture = $1;
X my $scale = $2;
X if ($picture eq "Normal") {
X $picheader{Normal} = $scale;
X } elsif ($picture eq "Header") {
X $picheader{Header} = $scale;
X } elsif ($picture eq "Index") {
X $picheader{Index} = $scale;
X } else {
X die "!!BUG!! \"Bad Option: Size=\" should be Normal|Header|Index.";
X }
X } else {
X die <<EOF;
\t"Option: Size-of-Picture=" should be formed as "(Title=scale)".
\t\t(Title is one of "Normal", "Header" and "Index".)
EOF
X }
X }
X die "Bad format.\n" if $_;
X
X my %value;
X foreach my $scale (keys %scale_dir) {
X my ($v,$mes) = check_scale($scale);
X die "In Scale-Directory:\n$mes\n" if $mes;
X if (exists $value{$v}) {
X die "!!BUG!! Scale value($v) doubly defined in Scale-Dierectory.";
X }
X $value{$v} = $scale;
X my $sn;
X if ($scale =~ m!(.+)/(.+)!) {
X $sn = "$1_$2";
X } elsif ($scale =~ m/(.*)\.(.*)/) {
X
X $sn = "$2" if (not defined $1 or $1 == 0);
X }
X $shrink_name{$scale} = ($v == 1 ? "" : ".$sn.");
X }
X unless (exists $value{1}) {
X die "!!BUG!! Raw image file (Scale=1) is not found.";
X }
X @sorted_scale = ();
X foreach my $v (sort keys %value) {
X unshift @sorted_scale,$value{$v};
X }
X $picrawdir = $scale_dir{$sorted_scale[0]};
} # end of get_shrink_size
X
sub get_only_shrink_size_from_file () {
X print "#",__LINE__,"# get_only_shrink_size_from_file\n" if $DEBUG;
X local %::option_scale = %::option_scale;
X local %::option_size = %::option_size;
X my $only_scale_and_size = 1;
X my $file;
X if (-r $CONFIG and -r $CONTENT) {
X $file = (stat($CONFIG)->mtime > stat($CONTENT)->mtime ?
X $CONFIG : $CONTENT);
X } elsif (-r $CONFIG) {
X $file = $CONFIG;
X } elsif (-r $CONTENT) {
X $file = $CONTENT;
X }
X set_option_from_file($file,$only_scale_and_size) if $file;
X get_shrink_size();
}
X
sub image_path ( $$ ) {
X my ($header,$image) = @_;
# print "#",__LINE__,"# image_path header='$header' image='$image'\n" if $DEBUG;
X unless ($image =~ /(.*)\.($IMGEXT)$/) {
X die "Bad image file name : ";
X }
X my ($base,$ext) = ($1,$2);
X my $path = "./"; # for mozilla
X ($path,$base) = ($1,$2) if $base =~ m!(.*/)([^/]+)$!;
X my $sub_theme = ($path and $path ne "./"); # sub theme image
X if ($sub_theme) { # theme image
X my $oldwd = cwd;
X chdir $path; # goto theme sub-directory
X get_only_shrink_size_from_file();
X chdir $oldwd;
X }
X my $scale;
X if ($header eq "Header" or $header eq "Index" or $header eq "Normal") {
X $scale = $picheader{$header};
X } elsif ($header eq "Raw") {
X $scale = $sorted_scale[0];
X } else {
X $scale = $header;
X }
X $path .= $scale_dir{$scale};
X my $real_image_path;
X if ($scale eq $sorted_scale[0]) {
X $real_image_path = "$path/$base.$ext";
X } else {
X $real_image_path = "$path/$base$shrink_name{$scale}$ext";
X }
X get_shrink_size() if $sub_theme; # restore variables for scale and dir.
# print "#",__LINE__,"# real_image_path='$real_image_path'\n" if $DEBUG;
X return $real_image_path;
} # end of image_path
X
######################################################################
X
my $depth = 0;
X
sub makephoto (@) {
X print "#",__LINE__,"# MAKEPHOTO dirs=`@_'\n" if $DEBUG;
X my @ds = @_;
X my $oldpwd = cwd;
X ++$depth;
X
X SPECIFIED_DIRECTORY:
X foreach my $d (@ds) {
X chdir $oldpwd;
X $d =~ s!/$!!;
X if (-l $d) {
X warn "$oldpwd/$d is symbolic link, skipped.\n" if $VERBOSE;
X next SPECIFIED_DIRECTORY;
X }
X chdir $d || die "Cannot change directory to \"$d\".\n";
X my $pwd = cwd; # Full Path
X if ($FORCEUPDATE) {
X if (-r $CONTENT) {
X rename "$CONTENT", "$CONTENT.OLD";
X warn <<EOF if $VERBOSE;
Force-update:
\t$pwd/$CONTENT renamed to $CONTENT.OLD
EOF
X }
X }
X my @dirs = ();
X my @dirs_rec = ();
X {
X get_only_shrink_size_from_file();
X foreach my $f (glob("*")) {
X next if $f =~ /^$ORIG$|^$ORIG\.|\.$ORIG$|\.$ORIG\./o;
X next if substr($f,0,1) eq substr($picrawdir,0,1);
X push @dirs, $f if -d $f;
X push @dirs_rec, $f if (-d $f && ! -l $f);
X }
X }
X if (@dirs_rec && $RECURSIVE) {
X makephoto(@dirs_rec);
X print "#",__LINE__,"# Back from recursive call. Now pwd=",cwd,"\n" if $DEBUG;
X }
X undef @dirs_rec;
X warn <<EOF if $VERBOSE;
Now, theme directory "$pwd" is processed.
EOF
X
X if ($CLEAN) {
X print "#",__LINE__,"# CLEAN\n" if $DEBUG;
X get_only_shrink_size_from_file();
X foreach my $scale (@sorted_scale[1..$#sorted_scale]) {
X my $dir = $scale_dir{$scale};
X if (-l $dir) {
X warn "$pwd/$dir is symbolic link, skipped.\n" if $VERBOSE;
X next;
X }
X my $cleaned;
X foreach my $f (glob "$dir/*") {
X next unless $f =~ m!/(.+)\.([^.]+)\.($IMGEXT)$!o;
X my $rf = "$1.$3";
X my $shrinkname = ".$2.";
X next unless $shrinkname eq $shrink_name{$scale};
X unless (-f "$picrawdir/$rf") {
X unlink $f;
X warn "unlink $pwd/$f\n" if $VERBOSE;
X $cleaned = 1;
X }
X }
X warn "Cleaned up bogus images on $dir\n"
X if $cleaned and $VERBOSE;
X }
X next SPECIFIED_DIRECTORY;
X } # end of CLEAN
X
X print "#",__LINE__,"# Now dir: ",cwd,"\n" if $DEBUG;
X my @tmp = ();
X while (my $d = shift @dirs) {
X if (-r "$d/$CONTENT") {
X push @tmp,$d;
X } else {
X warn "No $CONTENT under $pwd/$d/ ... skipped\n";
X }
X }
X @dirs = @tmp;
X print "#",__LINE__,"# \@dirs=(@dirs)\n" if $DEBUG;
X
X my @images = ();
X foreach my $f (glob("$picrawdir/*")) {
X next if $f =~ /\.$ORIG$|\.$ORIG\./o;
X $f =~ s!.+/!!; # remove directory part
X push @images, $f
X if -r "$picrawdir/$f" and $f =~ /\.($IMGEXT)$/o;
X }
X print "#",__LINE__,"# \@images=(@images)\n" if $DEBUG;
X
X my $should_be_updated = $FORCEUPDATE;
X
X my $mkshrink;
X foreach my $f (@images) {
X my ($base,$dir,$ext) = fileparse $f, '\.[^.]*';
X push @images, $f if -r $f;
X foreach my $scale (@sorted_scale[1..$#sorted_scale]) {
X my $rawfile = image_path("Raw", $f);
X my $shrinkfile = image_path($scale,$f);
X unless (-e "$shrinkfile" &&
X (stat($shrinkfile)->mtime > stat("$rawfile")->mtime)) {
X unless (-d $scale_dir{$scale}) {
X mkdir $scale_dir{$scale},$DMODE;
X warn "Directory \"$pwd/$scale_dir{$scale}\" is created\n"
X if $VERBOSE;
X }
X warn "Shrink image(s) for \"$pwd/$picrawdir\".\n"
X if $VERBOSE and not $mkshrink;
X $mkshrink = 1;
X if ($scale =~ m!^1/[248]$!) {
X die "$DJPEG : cannot be executed.\n" unless -x $DJPEG;
X die "$CJPEG : cannot be executed.\n" unless -x $CJPEG;
X system "$DJPEG -scale $scale $rawfile | $CJPEG >$shrinkfile";
X } else {
X my ($v,$mess) = check_scale($scale);
X die "!!BUG!! $mess : " if $mess;
X die "$JPEGTOPNM : cannot be executed.\n" unless -x $JPEGTOPNM;
X die "$PNMSCALE : cannot be executed.\n" unless -x $PNMSCALE;
X die "$PNMTOJPEG : cannot be executed.\n" unless -x $PNMTOJPEG;
X system
X "$JPEGTOPNM $rawfile | $PNMSCALE $v | $PNMTOJPEG >$shrinkfile";
X }
X die "Cannot shrink $pwd/$rawfile.\n" if $?;
X $should_be_updated = 1
X }
X }
X }
X
X if (not $should_be_updated and -f $CONFIG and -f $CONTENT) {
X $should_be_updated = 1
X if stat($CONFIG)->mtime > stat($CONTENT)->mtime ;
X }
X if (-f $CONTENT) {
X unless ($should_be_updated) {
X if (@images) {
X foreach my $d (values %scale_dir) {
X if (! -d $d or stat($CONTENT)->mtime < stat($d)->mtime) {
X $should_be_updated = 1;
X print "#",__LINE__,
X "# No $d, or \$CONTENT($CONTENT) is older than $d\n" if $DEBUG;
X last;
X }
X }
X } else {
X warn "No image on $pwd\n" if $VERBOSE;
X }
X if (@dirs) {
X foreach my $d (@dirs) {
X if (stat($CONTENT)->mtime < stat($d)->mtime) {
X $should_be_updated = 1;
X print "#",__LINE__,"# \$CONTENT($CONTENT) is older than $d\n" if $DEBUG;
X last;
X }
X }
X } else {
X warn "No sub-theme directory on $pwd\n" if $VERBOSE;
X }
X }
X } else {
X $should_be_updated = 1;
X warn "$pwd/$CONTENT is not found.\n" if $VERBOSE;
X }
X
X unless ($should_be_updated) {
X warn "No update for $CONTENT and $HTML on $pwd\n" if $VERBOSE;
X next SPECIFIED_DIRECTORY;
X }
X
X ### $CONENT and $HTML should be updated. ###
X
X my $option_on;
X local $::opt_lang = $::opt_lang;
X local $::opt_order = $::opt_order;
X local $::opt_image = $::opt_image;
X local $::opt_theme = $::opt_theme;
X local $::opt_config = $::opt_config;
X local $::opt_mail = $::opt_mail;
X local $::opt_uname = $::opt_uname;
X local $::opt_usenkf = $::opt_usenkf;
X local $::opt_messagefile = $::opt_messagefile;
X local $::opt_scale = $::opt_scale;
X local $::opt_size = $::opt_size;
X local %::html_charset = %::html_charset;
X local %::html_album = %::html_album;
X local %::html_comment = %::html_comment;
X local %::html_theme = %::html_theme;
X local %::html_latest = %::html_latest;
X local %::html_arrow = %::html_arrow;
X local %::html_back = %::html_back;
X
X my $theTheme_on;
X my $theTheme_theme = get_default_theme();
X my $theTheme_image;
X my $theTheme_comment = "";
X my @contents;
X if (-r $CONTENT) {
X rename "$CONTENT", "$CONTENT.OLD";
X warn "$pwd/$CONTENT : renamed to $CONTENT.OLD\n" if $VERBOSE;
X }
X
X if (-r $CONFIG) {
X warn "$pwd/$CONFIG is found.\n" if $VERBOSE;
X open(IN,$CONFIG) || die "Cannot read $pwd/$CONFIG : $!";
X while ($_ = get_config(*IN,$::opt_lang,$::opt_usenkf)) {
X if (/^Ver(sion)?:/i) {
X next ; # version checked already
X } elsif (/^Opt(ion)?:$/i) {
X die "\"Option:\" doubly defined at $pwd/$CONFIG line $ILN.\n"
X if $option_on;
X $option_on = 1;
X while ($_ = get_config(*IN,$::opt_lang,$::opt_nkf)) {
X last if /^\S/;
X set_option("conf",$_);
X }
X get_shrink_size();
X redo; ### End of Option:
X } elsif (/^$PTHEME:$/io) {
X die "\"Theme:\" doubly defined at $pwd/$CONFIG line $ILN.\n"
X if $theTheme_on;
X $theTheme_on = 1;
X while ($_ = get_config(*IN,$::opt_lang,$::opt_nkf)) {
X last if /^\S|^$/;
X if (s/^\s+$PTHEME=\s*//i) {
X $theTheme_theme = $_;
X } elsif (s/^\s+$PIMAGE=\s*//i) {
X $theTheme_image = $_;
X } elsif (s/^\s+Com(ment)?=\s*//i) {
X s/^\s+//;
X $theTheme_comment = $_;
X while ($_ = get_config(*IN,$::opt_lang,$::opt_nkf)) {
X last if /^\S|^\s+[\w\.-]+=/;
X s/^\s+//;
X $theTheme_comment .= "\n\t\t$_";
X }
X redo;
X } elsif (/^\s+Latest=\s*/) {
X warn <<EOF;
Warn at $pwd/$CONFIG line $ILN :
X "Latest=" item in "Theme:" section is invalid for configuration.
X Please remove it. ... ignored.
EOF
X } else {
X die <<EOF;
Error at $pwd/$CONFIG line $ILN :
\tTheme: "$_" is bad theme option.
EOF
X }
X }
X redo; ### End of Theme:
X } elsif (s!^(\S+)/$!!) {
X print "#",__LINE__,"# \"Sub-Theme:$1\" gotten\n" if $DEBUG;
X my $theme_dir = $1;
X @dirs = grep {$_ ne $theme_dir} @dirs; # remove it from @dirs
X my $theme;
X my ($image,$comment) = ("","");
X while ($_ = get_config(*IN,$::opt_lang,$::opt_nkf)) {
X last if /^\S|^$/;
X if (s/^\s+$PTHEME=\s*//i) {
X $theme = $_;
X } elsif (s/^\s+$PIMAGE=\s*//i) {
X $image = $_;
X my $im = "theme_dir/$image";
X $im =~ s!/(.+)$!/$picrawdir/$1!;
X unless (-r $im) {
X $image = "";
X warn "Theme image($im) is not found in $pwd/$CONFIG",
X " ... ignored.\n";
X }
X } elsif (s/^\s+Com(ment)?=\s*//i) {
X s/^\s+//;
X $comment = "$_";
X while ($_ = get_config(*IN,$::opt_lang,$::opt_nkf)) {
X last if /^\S|^\s+[\w\.-]+=/;
X s/^\s+//;
X $comment .= "\n\t\t$_";
X }
X redo;
X } else {
X die <<EOF;
Error at $pwd/$CONFIG line $ILN :
\t$theme_dir/ "$_" is bad theme option.
EOF
X }
X }
X if (-r "$theme_dir/$CONTENT") {
X my ($d_theme,$d_image,$d_comment,$mtime)
X = getTheme("$theme_dir/$CONTENT");
X $theme = $d_theme unless $theme;
X $image = $d_image unless $image;
X $comment = $d_comment unless $comment;
X push @contents,{ "ThemeDir" => $theme_dir,
X "Theme" => $theme,
X "Image" => $image,
X "Comment" => $comment,
X "Mtime" => $mtime
X };
X }
X redo; # end of sub theme
X } elsif (s/^(\S+):$//) {
X my $image_file = $1;
X die <<EOF unless $image_file =~ /\.($IMGEXT)$/o;
Error at $pwd/$CONFIG line $ILN :
\tImage: "$image_file" does not have proper extension of image.
EOF
X @images = grep {$_ ne $image_file} @images; # remove it from @images
X my ($name,$date,$comment) = ("","","");
X while ($_ = get_config(*IN,$::opt_lang,$::opt_nkf)) {
X last if /^\S|^$/;
X if (s/^\s+Name?=\s*//i) {
X $name = $_;
X } elsif (s/^\s+Date?=\s*//i) {
X $date = $_;
X } elsif (s/^\s+Com(ment)?=\s*//i) {
X s/^\s+//;
X $comment = "$_";
X while ($_ = get_config(*IN,$::opt_lang,$::opt_nkf)) {
X last if /^\S|^\s+[\w\.-]+=/;
X s/^\s+//;
X $comment .= "\n\t\t$_";
X }
X redo;
X } else {
X die <<EOF;
Error at $pwd/$CONFIG line $ILN :
\tImage: "$_" is bad theme option.
EOF
X }
X }
X my $mtime = get_mtime_of_original_file($image_file);
X if (defined $mtime) {
X push @contents,{ "ImageFile" => $image_file,
X "Name" => $name,
X "Date" => $date,
X "Comment" => $comment,
X "Mtime" => $mtime
X };
X } else {
X warn "$image_file: specified at $pwd/$CONFIG line $ILN,",
X " but not found ... skipped.\n";
X }
X redo;
X } # end of image
X }
X close(IN);
X } # end of config
X
X print "#",__LINE__,"# Option: Language=$::opt_lang, Order=$::opt_order, Image=$::opt_image, Theme=$::opt_theme, Config=$::opt_config\n" if $DEBUG;
X
X get_shrink_size();
X
X my @here_d;
X while (my $d = shift @dirs) { # add new SubTheme entries to Contents
X if (-r "$pwd/$d/$CONTENT") {
X my ($theme,$image,$comment,$mtime) = getTheme("$pwd/$d/$CONTENT");
X push @here_d,{ "ThemeDir" => $d,
X "Theme" => $theme,
X "Image" => $image,
X "Comment" => $comment,
X "Mtime" => $mtime
X }
X } else {
X die "!!BUG!! No $pwd/$d/$CONTENT found. : ";
X }
X }
X undef @dirs;
X
X my @here_f;
X while (my $f = shift @images) { # add new Image entries to here_f
X my $mtime = get_mtime_of_original_file($f);
X my $date = ctime($mtime);
X push @here_f,{ "ImageFile" => $f,
X "Name" => $f,
X "Date" => $date,
X "Comment" => "",
X "Mtime" => $mtime
X }
X }
X undef @images;
X
X print "#",__LINE__,"# opt_config=\"$::opt_config\"\n" if $DEBUG;
X if ($::opt_config eq "Non") {
X foreach (@contents) {
X if (exists $_->{ThemeDir}) {
X push @here_d,$_;
X } else {
X $_->{Mtime} = get_mtime_of_original_file($_->{ImageFile});
X $_->{Date} = ctime($_->{Mtime}) unless $_->{Date};
X push @here_f, $_;
X }
X }
X }
X
X my @here;
X if ($::opt_order =~ /^New-|^Old-/) {
X print "#",__LINE__,"# opt_order=\"$::opt_order\"\n" if $DEBUG;
X @here = sort {$a->{Mtime} <=> $b->{Mtime}} (@here_d,@here_f);
X @here = reverse(@here)
X if $::opt_order eq "New-First" or $::opt_order eq "Old-Last";
X } else {
X @here_d = sort {$a->{Mtime} <=> $b->{Mtime}} @here_d;
X @here_f = sort {$a->{Mtime} <=> $b->{Mtime}} @here_f;
X
X @here_d = reverse(@here_d) if $::opt_theme eq "Reverse";
X @here_f = reverse(@here_f) if $::opt_image eq "Reverse";
X
X if ($::opt_order eq "Image-First") {
X @here = (@here_f,@here_d); # Order=Image-First
X } else {
X @here = (@here_d,@here_f); # Order=Directoy-First
X }
X }
X undef @here_d;
X undef @here_f;
X
X if ($::opt_config eq "Last") {
X @contents = (@here,@contents); # Config=Last
X } elsif ($::opt_config eq "First") {
X @contents = (@contents,@here); # Config=First
X } else {
X @contents = @here; # Config=Non
X }
X undef @here;
X
X rename "$CONTENT", "$CONTENT.OLD" if -r $CONTENT;
X unless (@contents) {
X if (-r $CONFIG) {
X warn "Configuration file($CONFIG) exists but no image found\n",
X " under $pwd ... ignored.\n";
X } else {
X warn "No image in this directory($pwd) ... skipped.\n";
X }
X next SPECIFIED_DIRECTORY;
X }
X
X unless ($theTheme_image) {
X my $c = $contents[0];
X if (exists $c->{ImageFile}) {
X $theTheme_image = $c->{ImageFile};
X } elsif (exists $c->{ThemeDir}) {
X $theTheme_image = "$c->{ThemeDir}/$c->{Image}";
X } else {
X die "!!BUG!! Cannot get default theme image on $pwd : ";
X }
X }
X
X ### Generate Contents file ###
X print "#",__LINE__,"# Generate Contents: $pwd/$CONTENT\n" if $DEBUG;
X
X my $max_mtime = 0;
X foreach my $c (@contents) {
X $max_mtime = $c->{Mtime} if $max_mtime < $c->{Mtime};
X }
X
X my $ctime = ctime();
X my $latestdate = ctime($max_mtime);
X my $content_db = <<EOF;
# $CONTENT: Do not edit this!
# This file was generated by $PNAME at $ctime
X
Version:
\t$PNAME $VERSION
X
Option:
\tOrder=$::opt_order
\tImage=$::opt_image
\tTheme=$::opt_theme
\tConfig=$::opt_config
\tLanguage=$::opt_lang
\tMessage-File=$::opt_messagefile
\tNkf=$::opt_usenkf
\tMail-Address=$::opt_mail
\tUser-Name=$::opt_uname
\tScale-Directory=$::opt_scale
\tSize-of-Picture=$::opt_size
X
Theme:
\tTheme=$theTheme_theme
\tImage=$theTheme_image
\tComment=$theTheme_comment
\tLatest=$max_mtime ($latestdate)
X
EOF
X foreach my $c (@contents) {
X if (exists $c->{ThemeDir}) {
X $content_db .= <<EOF;
$c->{ThemeDir}/
\tTheme=$c->{Theme}
\tImage=$c->{Image}
\tComment=$c->{Comment}
EOF
X } elsif (exists $c->{ImageFile}) {
X $content_db .= <<EOF;
$c->{ImageFile}:
\tName=$c->{Name}
\tDate=$c->{Date}
\tComment=$c->{Comment}
EOF
X } else {
X die "!!BUG!! No theme nor Image found on \@contents : ";
X }
X }
X open(CFILE,">$CONTENT") || die "Cannot write on $pwd/$CONTENT : $!";
X print CFILE $content_db;
X close(CFILE);
X undef $content_db;
X warn "$pwd/$CONTENT is updated.\n" if $VERBOSE;
X
X ### Generate photo.html ###
X my $back;
X $back = 1 if $BUTTON and $::html_back{$::opt_lang}
X and ($depth >= 2 or -r "../$HTML");
X my $html = undef;
X print "#",__LINE__,"# Generate $HTML\n" if $DEBUG;
X print "#",__LINE__,"# \$theTheme_image=`$theTheme_image'\n" if $DEBUG;
X my $titleimage = image_path("Header",$theTheme_image);
X $html = <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<!-- This is generated by $PNAME (version $VERSION).
\tYou can get the latest version of mkphotohtml and it\'s documents
\tfrom following web page;
\t\t$WEBINFO
X -->
<html>
X <head>
X <title>$theTheme_theme</title>
X </head>
X <META HTTP-EQUIV="Content-Type"
X CONTENT="text/html; charset=$::html_charset{$::opt_lang}">
X <body>
X <center>
X <h1>$theTheme_theme</h1>
X <img src="$titleimage"
X alt="Theme-image: $theTheme_theme"><br>
X $theTheme_comment
X </center>
EOF
X $html .= <<EOF if $back;
X <a href="../$HTML">$::html_back{$::opt_lang}</a>
EOF
X $html .= <<EOF;
X <h1>$::html_album{$::opt_lang}</h1>
X $::html_comment{$::opt_lang}
X <br><br>
EOF
X while (my $c = shift @contents) {
X if (exists $c->{ThemeDir}) { # SubThemeDir
X my $subtheme_image = image_path("Index","$c->{ThemeDir}/$c->{Image}");
X my $date = ctime($c->{Mtime});
X print "#",__LINE__,"# \$subtheme_image=$subtheme_image\n" if $DEBUG;
X $html .= <<EOF;
X <a href="$c->{ThemeDir}/$HTML">
X <img src="$subtheme_image"
X alt="CLICK HERE" align="left"></a>
X <font size="+2">$::html_theme{$::opt_lang}$c->{Theme}</font><br>
X <font size="-1">$::html_latest{$::opt_lang} $date</font><br>
X $c->{Comment}<br clear="left">
EOF
X } elsif (exists $c->{ImageFile}) { # Image file
X $c->{ImageFile} =~ /(.*)(\.[^.]+)/;
X my ($base,$ext) = ($1,$2);
X my $imagefiles = "<a href=\""
X . image_path("Raw",$c->{ImageFile})
X . "\">$sorted_scale[0]</a>";
X for my $scale (@sorted_scale[1..$#sorted_scale]) {
X my $ifile = image_path($scale,$c->{ImageFile});
X $imagefiles .= "\n\t, <a href=\"$ifile\">$scale</a>";
X }
X my $image_normal = image_path("Normal",$c->{ImageFile});
X my $image_index = image_path("Index", $c->{ImageFile});
X $html .= <<EOF;
X <a href="$image_normal">
X <img src="$image_index"
X alt="CLICK HERE" align="left"></a>
X <font size="-1">
X $::html_arrow{$::opt_lang} $imagefiles
X </font><br>
X <strong><font size="+1">$c->{Name}</font></strong><br>
X <font size="-1">$c->{Date}</font><br>
X $c->{Comment}<br clear="left">
EOF
X } else {
X die "!!BUG!! Broken \@contents\n";
X }
X }
X
X my $time = ctime();
X $_ = $::opt_mail;
X if (/\$userid\b|\${userid}/i) {
X s/\$userid\b|\${userid}/$ENV{USER}/ig;
X }
X if (/\$fqdn\b|\${fqdn}/i) {
X my $f = qx($HOSTNAME -f);
X chomp $f;
X s/\$fqdn\b|\${fqdn}/$f/ig;
X }
X if (/\$domain\b|\${domain}/i) {
X my $d = qx($HOSTNAME -d);
X chomp $d;
X s/\$domain\b|\${domain}/$d/ig;
X }
X
X my $mail_address = $_;
X $_ = $::opt_uname;
X if (/^\$passwd$/i) {
X open(INP,"/etc/passwd") || die "Cannot read /etc/passwd : $!";
X while (<INP>) {
X next unless /^$ENV{USER}:/o;
X /.*?:.*?:.*?:.*?:(.*)?:/;
X $_ = $1;
X s/,.*//s; # Full name of the user
X last;
X }
X close(INP);
X die "User name of \"$ENV{USER}\" is not found in /etc/passwd.\n"
X unless $_;
X }
X if ($::opt_usenkf eq "Use" and $::opt_lang eq "Japanese") {
X $_ = change_to_jis($_); # change code to 7bit jis
X chomp;
X print "#",__LINE__,"# User-Name with nkf, \$_=\"$_\"\n" if $DEBUG;
X }
X
X $html .= <<EOF;
X <hr>
EOF
X $html .= <<EOF if $back;
X <a href="../$HTML">$::html_back{$::opt_lang}</a>
EOF
X unless (/^\$non?$/i or $mail_address =~ /^\$non?$/i) {
X $html .= <<EOF;
X <address><a href="mailto:<$mail_address>">
X $_</a></address>
EOF
X }
X $html .= <<EOF;
X Last modified: $time
X </body>
</html>
EOF
X rename "$HTML", "$HTML.OLD" if -r $HTML;
X open(HTML,">$HTML") || die "Cannot write on $pwd/$HTML : $!";
X print HTML $html;
X close(HTML);
X warn "$pwd/$HTML is updated.\n" if $VERBOSE;
X }
X chdir $oldpwd;
X --$depth;
}
SHAR_EOF
(set 20 03 07 29 23 26 54 'bin/mkphotohtml'; eval "$shar_touch") &&
chmod 0755 'bin/mkphotohtml' ||
$echo 'restore of' 'bin/mkphotohtml' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'bin/mkphotohtml:' 'MD5 check failed'
da62fdf5c2a237bad40de9181f1b1099 bin/mkphotohtml
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'bin/mkphotohtml'`"
test 48884 -eq "$shar_count" ||
$echo 'bin/mkphotohtml:' 'original size' '48884,' 'current size' "$shar_count!"
fi
fi
rm -fr _sh05420
exit 0
Fnews-brouse 1.9(20180406) -- by Mizuno, MWE <mwe@ccsf.jp>
GnuPG Key ID = ECC8A735
GnuPG Key fingerprint = 9BE6 B9E9 55A5 A499 CD51 946E 9BDC 7870 ECC8 A735