#!/usr/bin/perl # Filename: album # Author: David Ljung Madison # See License: http://MarginalHacks.com/License/ my $VERSION= 2.52; # Description: Makes a photo album use strict; use IO::File; #use locale; # Does Windows have this? umask 022; # 0755 ################################################## ################################################## # SETTINGS ################################################## ################################################## my $PROGNAME = $0; $PROGNAME =~ s|.*/||; # Windows users will probably want to specify full paths, such as: # my $CONVERT = 'C:/PROGRAM FILES/IMAGEMAGICK/convert.exe'; # my $IDENTIFY = 'C:/PROGRAM FILES/IMAGEMAGICK/identify.exe'; # Win98: Slightly different version #WIN98#$VERSION .= " (win98)"; # Win98: Needs TCAP: ftp://ftp.simtel.net/pub/simtelnet/msdos/sysutl/tcap31.zip #WIN98#my $TCAP = 'tcap'; #WIN98#my $TCAP_FILE = "atrash.tmp"; #WIN98## Put tcap args in the tcap env var, so to reduce line length (128 limit) #WIN98#$ENV{tcap}="-overwrite *${TCAP_FILE}"; my $CONVERT = "convert"; my $IDENTIFY = "identify"; # Undef if you don't have identify my $JHEAD = "jhead"; # Extract EXIF info from jpgs my $FFMPEG = "ffmpeg"; # For extracting movie frames # Default directory page my $HTML = ".html"; my $DEFAULT_INDEX = "index$HTML"; # Don't need to specify this index my $HEADER = "header.txt"; my $FOOTER = "footer.txt"; my $NO_ALBUM = ".no_album"; # Don't run album on these dirs/files my $HIDE_ALBUM = ".hide_album"; # Don't even show these directories my $NOT_IMG = ".not_img"; # Postfix for files that aren't images # Avoid "Broken pipe" messages $SIG{PIPE} = 'IGNORE'; ######################### # abs_path ######################### use Cwd 'abs_path'; # If you don't have the Cwd module, use this: #sub abs_path { # my ($dir) = @_; # my $pwd=`pwd`; chomp($pwd); # chdir($dir) || usage("Couldn't find [$dir]"); # my $name=`pwd`; chomp($name); # chdir($pwd); # $name; #} my %DEFAULTS = ( # Thumbnail stuff 'x' => 133, # Size of thumbnails 'y' => 100, 'crop' => 1, # Crop or just scale? 'CROP' => "", # top, bottom, left or right 'force' => 0, # Force thumbnail generation 'type' => "jpg", # Thumbnail image type 'medium_type' => "", # Medium Thumbnail image type 'dir' => "tn", # Thumbnail directory 'known_images' => 0, # I'd rather keep my album clean 'sample' => 0, # -sample:-geometry :: fast:better 'animated_gifs' => 0, # Use [0] in convert for animated gifs # Album stuff 'medium' => "", # Make medium size pictures? 'just_medium' => 0, # Don't link to full size images 'image_pages' => 1, # Page per image 'embed' => 1, # Use embed for non-pic image pages 'index' => $DEFAULT_INDEX, # Default index 'body' => "", # tag 'top' => "..", # The "Back" for the top album 'columns' => 4, # Number of images per row 'file_sizes' => 0, # Show image file sizes 'image_sizes' => 0, # Get image sizes (width*height) 'clean' => 0, # Clean garbage out of thumbnail dir? 'captions' => "captions.txt", # Captions filename? 'caption_edit' => 0, # Add tags for editing captions CGI 'exif' => "", # Format for EXIF caption string 'fix_urls' => 1, # Encode unsafe characters as %xx in URL 'depth' => -1, # Depth to descend directories 'add' => "", # Add these directories to the album 'all' => 0, # Do not hide .directories 'hashes' => 1, # Show hash progress marks 'name_length' => 40, # Limit length of image names 'date_sort' => 0, # Sort by date 'name_sort' => 0, # Sort by name, ignore caption order 'reverse_sort' => 0, # Reverse sorting 'charset' => "iso-8859-1",# Charset for default theme 'image_loop' => 1, # Do image pages loop around? # eperl stuff 'enter_eperl' => '<:', # Start code region in theme 'leave_eperl' => ':>', # Leave code region in theme # Ignore this stuff.. 'transform_url' => "", # Hack for transforming image URL # deprecated, it's automated now 'identify' => 1, # Use identify or convert for get_size? 'theme_url' => "", # In case we need to specify theme URL 'theme' => "", # So that -no_theme works, ignored. ); # As of "ImageMagick 4.2.9 99/09/01" # May not be the same as your version of convert, but damn it's alot! my $IMAGE_TYPES = "AVS|BMP|BMP24|CMYK|DCM|DCX|DIB|EPDF|EPI|EPS|EPS2|EPSF|EPSI|EPT|FAX|". "FITS|G3|GIF|GIF87|GRADATION|GRANITE|GRAY|HDF|HISTOGRAM|ICB|ICC|ICO|". "IPTC|JPG|JPEG|JPEG24|LABEL|LOGO|MAP|MATTE|MIFF|MNG|MONO|MPG|MPEG|MTV|NULL|P7|". "PBM|PCD|PCDS|PCL|PCT|PCX|PDF|PIC|PICT|PICT24|PIX|PLASMA|PGM|PM|PNG|". "PNM|PPM|PREVIEW|PS|PS2|PS3|PSD|PTIF|PWP|RAS|RGB|RGBA|RLA|RLE|SCT|SFW|". "SGI|SHTML|STEGANO|SUN|TEXT|TGA|TIF|TIFF|TIFF24|TILE|TIM|TTF|TXT|UIL|". "UYVY|VDA|VICAR|VID|VIFF|VST|X|XBM|XC|XPM|XV|XWD|YUV"; $IMAGE_TYPES.="|AVI|MOV|MOOV" if $FFMPEG; # ffmpeg can handle AVI, MOV ######################### # Windows blows ######################### my $OSX = ($^O =~ /darwin/i) ? 1 : 0; my $CRAPPY_OS = (!$OSX && ($^O =~ /Win/i)) ? 1 : 0; # Win98=MSWin, WinXP=MSWin (damn), CygWin=cygwin # 1) Can't handle "\Qfile\E"; sub file_quote { my ($file) = @_; $CRAPPY_OS ? "\"$file\"" : "\Q$file\E"; } # 2) Can't create .files $NO_ALBUM =~ s/^\.//g if $CRAPPY_OS; $HIDE_ALBUM =~ s/^\.//g if $CRAPPY_OS; # 3) Stupid $0 is probably '/' not '\' if ($CRAPPY_OS && $0 =~ m|\\|) { # Guess $PROGNAME = $0; $PROGNAME =~ s|.*\\||; } # 4) Can't handle 'open(FOO,"cmd |")' or 2>&1 # (According to one mail, 2>&1 works in Win2000) sub open_pipe { my ($cmd) = @_; print STDERR "run: $cmd\n" if ($MAIN::DEBUG); my $fh = new IO::File; # Happy Unix return (open($fh, "$cmd 2>&1 |")) && $fh unless $CRAPPY_OS; # Win98 (use TCAP) #WIN98# system("$TCAP -c $cmd"); #WIN98# (open($fh, "$TCAP_FILE")) || die("Can't open $TCAP output [$TCAP_FILE]\n"); #WIN98# return $fh; # Windows2000,XP: -| pipe method, doesn't seem to work on Win98 my $pid = (open($fh,"-|")); return undef unless defined $pid; # Failed return $fh if $pid; # Parent # Child (open(STDERR,">&STDOUT")) || die("open_pipe(): Can't dup stdout\n"); exec($cmd); } # 4 1/2) Clean up the tmp file (for Win98) #WIN98# sub win_done { print STDERR "@_\n"; unlink($TCAP_FILE); exit; } #WIN98# if ($CRAPPY_OS) { #WIN98# $SIG{INT} = \&win_done; $SIG{TERM} = \&win_done; #WIN98# $SIG{HUP} = \&win_done; $SIG{QUIT} = \&win_done; #WIN98# $SIG{EXIT} = \&win_done; $SIG{__DIE__} = \&win_done; #WIN98# } # 5) Can't handle /dev/null? # (Need to figure this out - make a tmpfile? $DEV_NULL = ...?) # 6) .exe extension if we don't have it if ($CRAPPY_OS) { $CONVERT =~ s/\.exe$//; $IDENTIFY =~ s/\.exe$//; $CONVERT .= ".exe"; $IDENTIFY .= ".exe"; } ######################### # URLs for these scripts - don't change ######################### my $HOME = "http://MarginalHacks.com/"; my $ALBUM_URL = "${HOME}Hacks/album/"; my $GEN_STRING = "album $HOME"; my $OLD_GEN_RE = "Generated by $PROGNAME and thumb"; ######################### # Stupid privoxy bug. ######################### sub concat { die(<\n"; print "\tMakes a photo album\n"; print "\n"; print "\tAll boolean options can be turned off with '-no_option'\n"; print "\t(Some are default on, defaults shown in [brackets])\n"; print "\n"; print "Album Options:\n"; print " -d Set debug mode\n"; print " -q Be quiet (we're hunting wabbits!)\n"; print " -medium Generate medium size images"; default("medium"); print " -just_medium And don't link to full-size images"; default("just_medium"); print " -image_pages Create a page for each image"; default("image_pages"); print " -embed Use image pages for non-picture image pages"; default("embed"); print " -columns Number of image columns"; default("columns"); print " -file_sizes Show image file sizes"; default("file_sizes"); print " -image_sizes Get image size (width*height) (for some themes)"; default("image_sizes"); print " -clean Remove unused thumbnails"; default("clean"); print " -captions Specify captions filename"; default("captions"); print " -caption_edit Add comment tags so that caption_edit.cgi will work"; default("caption_edit"); print " -exif Append exif info to captions. Use \%key\% in fmt string"; default("exif"); print " Example: -exif \"
Camera: %Camera model%\"\n"; print " If any %keys% are not found by jhead, nothing is appended.\n"; print " -fix_urls Encode unsafe chars as %xx in URLs"; default("fix_urls"); print " -known_images Only include known image types"; default("known_images"); print " -body Specify tags for default output (not themes)\n"; print " -top URL for 'Back' link on top page"; default("top"); print " -all Do not hide directories starting with '.'\n"; print " -depth Depth to descend directories (default infinite)\n"; print " -add Add a new directory to the album it's been placed in\n"; print " -hashes Show hash marks while generating thumbnails"; default("hashes"); print " -name_length Limit length of image/dir names"; default("name_length"); print " -date_sort Sort images/dirs by date instead of captions/name"; default("date_sort"); print " -name_sort Sort by name, not caption order"; default("name_sort"); print " -reverse_sort Sort in reverse"; default("reverse_sort"); print " -charset Charset for non-theme output"; default("charset"); print " -image_loop Do first and last image pages loop around?"; default("image_loop"); print " -index Select the default 'index.html' to use"; default("index"); print " Specifying '-index index' will force album to\n"; print " actually add 'index.html' to the end of links,\n"; print " which is useful if you use file://\n"; print "\n"; print "Thumbnail Options:\n"; print " -geometry=x Size of thumbnail [${DEFAULTS{'x'}}x${DEFAULTS{'y'}}]\n"; print " -type Thumbnail type (gif, jpg, tiff,...)"; default("type"); print " -medium_type Medium type (default is same type as full image)"; default("medium_type"); print " -crop Crop the image to fit thumbnail size\n"; print " else aspect will be maintained"; default("crop"); print " -CROP Force cropping to be top, bottom, left or right\n"; print " -dir Thumbnail directory"; default("dir"); print " -force Force overwrite of existing thumbnails\n"; print " else they are only written when changed"; default("force"); print " -sample convert -sample for thumbnails (faster, low quality)"; default("sample"); print " -animated_gifs Take first frame of animated gifs (only some systems)"; default("animated_gifs"); print " --scale_opts List of convert options, end with '--'\n"; print " (Also --med_scale_opts and --full_scale_opts..)\n"; print "\n"; print "Theme Options:\n"; print " -theme Specify a theme directory\n"; print " -theme_url In case you want to refer to the theme by absolute URL\n"; print " -no_theme Ignore album's previous theme settings\n"; print "\n"; print " -version Display program version info\n"; print "\n"; print "Author: David Ljung Madison\n"; print "Docs: $ALBUM_URL\n"; print "License: ${HOME}License/\n"; print "Please see! ${HOME}Pay/\n"; print "\n"; exit -1; } sub version { print "\n"; printf "This is $PROGNAME version $VERSION\n"; print "\n"; print "Copyright (c) 2000,2001,2002 David Ljung Madison <$HOME>\n"; print "\n"; exit -1; } sub set_size { my ($opt,$size) = @_; return ($opt->{'x'},$opt->{'y'}) = ($1,$2) if ($size =~ /^(\d+)x(\d+)$/); usage("Can't understand geometry [$size]"); } # Theme directories contain album.th and image.th sub get_themes { my ($opt,$dir_arg) = @_; $opt->{theme} = abs_path($dir_arg); $ARG_THEME = $dir_arg; my $dir = $opt->{theme}; my @new_opts; # Options specified by themes # If it's a directory, look for "image.th" and "album.th" usage("-theme needs to specify a directory [$dir]") unless (-d $dir); my $found = 0; if (-f "$dir/album.th") { $found++; $opt->{'album.th'} = "$dir/album.th"; push(@new_opts,get_theme($opt,'album.th')); } if (-f "$dir/image.th") { $found++; $opt->{'image.th'} = "$dir/image.th"; push(@new_opts,get_theme($opt,'image.th')); } usage("No themes found in [$dir]") unless $found; return @new_opts; } # Read in a whole template/theme file # Check for Meta() and Credit() # (These tags are actually needed for proper operation, # not just my ego gratification! Please don't override!) sub get_theme { my ($opt,$which) = @_; my $file = $opt->{$which}; my $data = "$which.data"; undef $opt->{$data}; # In case we've specified themes twice.. my @new_opts; my $top = 1; # Options can only be specified at the top of the file my $start_line = 1; # Privoxy web proxy software has a bug that converts " open(" to "concat(" # So I'll use "(open" everywhere. Dumbass proxy. (open(TEMP,"<$file")) || usage("Couldn't read theme [$file]"); my ($in_head,$saw_meta,$saw_credit); while () { if ($top && /^\s*(#c)?\s*(\/\/)?\s*options?:\s*(\S.*)/i) { my $option = $3; $option =~ s/\s+$//g; push(@new_opts,split(/\s+/,$option)); $start_line = $.+1; next; } $top = 0; push(@{$opt->{$data}},$_); $in_head=1 if (//i); if (/Meta\(\)/) { usage("Meta() must be inside ...") if (!$in_head); $saw_meta=1; } $in_head=0 if (/<\/head>/i); $saw_credit=1 if (/Credit\(\)/); } close(TEMP); usage("You need to call Meta() inside .. of [$file]") unless $saw_meta; usage("You need to call Credit() in your theme [$file]") unless $saw_credit; $opt->{"$which.line"} = $start_line; @new_opts; } sub parse_args { my $dir; my %opt; # Defaults %opt = %DEFAULTS; my @theme_args; # We can get args from the theme as well push(@ARGV,".") unless @ARGV; while (@ARGV || @theme_args) { undef $ARG_THEME unless (@theme_args); my $arg=shift(@theme_args) || shift(@ARGV); if ($arg =~ /^-h$/) { usage(); } if ($arg =~ /^--?v(ersion)?$/) { version(); } if ($arg =~ /^-(no_?)?d$/) { $MAIN::DEBUG = $1?0:1; next; } if ($arg =~ /^-(no_?)?q$/) { $MAIN::QUIET = $1?0:1; next; } if ($arg =~ /^-g(eom(etry)?)?(=(.+))?$/) { set_size(\%opt,$4 ? $4 : (shift(@theme_args) || shift(@ARGV))); next; } if ($arg =~ /^-theme(=(.+))?$/) { @theme_args = get_themes(\%opt, ($2?$2:(shift(@theme_args) || shift(@ARGV)))); next; } if ($arg =~ /^--(full_|med_|)scale_opts(=(.+))?$/) { my $scale_opts = "${1}scale_opts"; # --scale_opts= if ($3) { $opt{$scale_opts} .= "$3 "; # Theme: --scale_opts -- } elsif (@theme_args) { $opt{$scale_opts} .= shift(@theme_args)." " while (@theme_args && $theme_args[0] ne "--"); usage("Missing -- at end of $scale_opts") unless shift(@theme_args); # ARGV: --scale_opts -- } else { $opt{$scale_opts} .= shift(@ARGV)." " while (@ARGV && $ARGV[0] ne "--"); usage("Missing -- at end of $scale_opts") unless shift(@ARGV); } next; } if ($arg =~ /^-(no_?)?(.+)$/) { my ($no,$option) = ($1,$2); usage("Unknown option: $option") unless (defined $DEFAULTS{$option}); # Options that take arguments if ($option =~ /^(charset|medium|dir|type|medium_type|columns|captions|exif|index|top|body|CROP|depth|add|name_length|theme_url|transform_url)$/) { usage("Option [$option] can't be -no, it needs an argument") if ($no); my $val = shift(@theme_args); $val = shift(@ARGV) unless defined $val; if ($option eq "index" && ($val eq $DEFAULT_INDEX || $val.$HTML eq $DEFAULT_INDEX)) { undef $DEFAULT_INDEX; } else { $opt{$option} = $val; } } elsif ($option eq "theme") { $opt{notheme} = 1; undef $opt{theme}; undef $opt{'album.th'}; undef $opt{'image.th'}; } else { $opt{$option} = $no ? 0 : 1; # Need to override image themes $opt{'no_image_pages'} = 1 if ($option eq "image_pages" && $no); } next; } usage("Can't find directory $arg") unless (-d $arg); usage("Too many directories: $arg and $dir") if ($dir); $dir=$arg; # Did we specify a theme last time? unless (@ARGV || $opt{'notheme'} || $opt{theme}) { my $theme = previous_build_theme(\%opt,$dir); @theme_args = get_themes(\%opt,$theme) if ($theme); } } continue { # We're about done with args, get default (and make sure we get theme args) push(@ARGV,".") unless ($dir || @ARGV || @theme_args); } # Allow -no_image_pages to override themes if ($opt{'no_image_pages'}) { $opt{'image.th'}=0; $opt{'image_pages'}=0; } $opt{image_pages}=1 if $opt{'image.th'}; # -clean and hashes is ugly $opt{hashes}=0 if $opt{clean} || $MAIN::DEBUG || $MAIN::QUIET; # -caption_edit needs themes usage("Can't use -caption_edit without a theme") if $opt{caption_edit} && !$opt{theme}; # -medium needs image pages $opt{image_pages}=1 if $opt{medium}; # -just_medium needs -medium usage("Need to specify -medium with -just_medium option") if $opt{just_medium} && !$opt{medium}; # Add the .html flag if missing a postscript? $opt{index}.=$HTML unless $opt{index} =~ /\./; # -theme_url needs -theme usage("-theme_url requires -theme option (it does not replace it)") if $opt{theme_url} && !$opt{theme}; usage("-CROP must be top, bottom, left or right") if ($opt{CROP} && $opt{CROP} !~ /^(top|bottom|left|right)$/); printf "[$PROGNAME version $VERSION]\n" if $MAIN::DEBUG; # Take any post / off the "add" directory (should probably clean this better) $opt{add} =~ s|/+$||; $dir =~ s|/$||; # Little cleanup (\%opt,$dir); } ################################################## ################################################## # GENERATE HTML ################################################## ################################################## sub header { my ($opt,$d_H,$image_page,$dir,@parents) = @_; my @names = @parents; my $this = pop(@names); my $header = ""; my $back = $#names; my $index = ($opt->{index} eq $DEFAULT_INDEX) ? "" : $opt->{index}; while (my $n = pop(@names)) { $header = "$n : $header"; } $header.=$this; my $Up = $image_page ? "Back" : "Up"; my $UpUrl = "../$index"; $UpUrl = $opt->{'top'} unless ($#parents || $image_page); $UpUrl = "

$Up

" if $UpUrl && $UpUrl ne "''"; print ALBUM < Album: $this $opt->{'body'}

$header

 $UpUrl
END_OF_HEADER if (-f "$dir/$HEADER" && (open(HEADER,"<$dir/$HEADER"))) { while(
) { print ALBUM; } print ALBUM "
\n"; } } sub footer { my ($dir) = @_; if (-f "$dir/$FOOTER" && (open(FOOTER,"<$dir/$FOOTER"))) { while(