#!/usr/bin/env perl # Alright, I'm modifying this pretty heavily now # Filename: album # Author: David Ljung Madison # Hacked slightly by Tim Skirvin # See License: http://MarginalHacks.com/License my $VERSION= "2.36tms"; # Description: Makes a photo album use strict; use IO::File; umask 022; # 0755 ################################################## ################################################## # SETTINGS ################################################## ################################################## my $PROGNAME = $0; $PROGNAME =~ s|.*/||; # Default directory page my $HTML = ".html"; my $DEFAULT_INDEX = "index"; # 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 ######################### # abs_path ######################### use Cwd 'abs_path'; my %DEFAULTS = ( # Album stuff # Shoudl do a count of the number of images we're displaying in sub-categories 'image_pages' => 1, # Page per image 'index' => "index", # Default index 'body' => "", # tag 'top' => "..", # The "Back" for the top album 'columns' => 4, # Number of images per row 'clean' => 0, # Clean garbage out of thumbnail dir? 'captions' => "captions.txt", # Captions filename? 'fix_urls' => 1, # Convert spaces to %20 in URLs? 'depth' => 1, # Depth to descend directories '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 # eperl stuff 'enter_eperl' => '<:', # Start code region in theme 'leave_eperl' => ':>', # Leave code region in theme # deprecated, it's automated now 'identify' => 1, # Use identify or convert for get_size? '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"; ######################### # 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 ######################### # URLs for these scripts - don't change ######################### my $HOME = "http://MarginalHacks.com/"; my $ALBUM_URL = "http://MarginalHacks.com/Hacks/album"; my $GEN_STRING = "album http://MarginalHacks.com/"; my $OLD_GEN_RE = "Generated by $PROGNAME and thumb"; ################################################## ################################################## # COMMAND-LINE OPTIONS ################################################## ################################################## sub default { my $d = $DEFAULTS{$_[0]}; print $d==1 ? " [ON]\n" : $d ? " [$d]\n" : "\n"; } my $ARG_THEME; # Themes can specify args - show where they came from # sub usage { die "Ignoring this for now\n"; } sub usage { } sub version { die "$PROGNAME v%4.2f\n",$VERSION; } # This should be changed to one of the Getopt things. 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 =~ /^-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 =~ /^(medium|dir|type|medium_type|columns|captions|index|top|body|CROP|depth|name_length)$/) { usage("Option [$option] can't be -no, it needs an argument") if ($no); my $val = (shift(@theme_args) || shift(@ARGV)); if ($option eq "index" && $val eq $DEFAULT_INDEX) { undef $DEFAULT_INDEX; } else { $opt{$option} = $val; } } elsif ($option eq "theme") { $opt{'notheme'} = 1; } 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; } 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; # -medium needs image pages $opt{image_pages}=1 if $opt{medium}; # We'll add the .html flag $opt{'index'} =~ s/\Q$HTML\E$//; usage("-CROP must be top, bottom, left or right") if ($opt{CROP} && $opt{CROP} !~ /^(top|bottom|left|right)$/); printf "[$PROGNAME version %4.2f]\n",$VERSION if $MAIN::DEBUG; $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'}$HTML"; while (my $n = pop(@names)) { $header = "$n : $header"; } $header.=$this; my $Up = $image_page ? "Back" : "Up"; my $UpUrl = "../" . ($opt->{'index'} eq $DEFAULT_INDEX ? "" : "$opt->{'index'}$HTML"); $UpUrl = $opt->{'top'} unless ($#parents || $image_page); $UpUrl = "

$Up

" if $UpUrl && $UpUrl ne "''"; if (-f "$dir/$HEADER" && open(HEADER,"<$dir/$HEADER")) { while(

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