#!/usr/bin/perl # Filename: caption_index # Author: David Ljung Madison # See License: http://MarginalHacks.com/License # Description: Generates a caption index for an entire photo album # OBSOLETE! See utils/index plugin for album v3.10 and higher! use strict; umask 022; # 0755 ################################################## # Setup the variables ################################################## 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'; # 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; #} # Most are ignored 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 # Album stuff 'medium' => "", # Make medium size pictures? '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 '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? '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 # 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 $CRAPPY_OS = ($^O =~ /Win/i) ? 1 : 0; # 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|.*\\||; } ######################### # URLs for these scripts - don't change ######################### my $HOME = "http://MarginalHacks.com/"; my $ALBUM_URL = "http://MarginalHacks.com/Hacks/album"; ################################################## ################################################## # COMMAND-LINE OPTIONS ################################################## ################################################## sub usage { my $msg; foreach $msg (@_) { print "ERROR: $msg\n"; } print "\n"; print "Usage:\t$PROGNAME [-album options] \n"; print "\tGenerates a caption index for an entire photo album\n"; print "\n"; print "\tUses same options as album, most are ignored\n"; print "\t(Just replace 'album' in call with '$PROGNAME'\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 parse_args { my $dir; my %opt; # Defaults %opt = %DEFAULTS; while (@ARGV) { my $arg=shift(@ARGV); if ($arg =~ /^-h$/) { usage(); } if ($arg =~ /^-(no_?)?d$/) { $MAIN::DEBUG = $1?0:1; next; } if ($arg =~ /^-g(eom(etry)?)?(=(.+))?$/) { $4 || shift(@ARGV); next; } if ($arg =~ /^-theme(=(.+))?$/) { $2 || shift(@ARGV); next; } if ($arg =~ /^--(full_|med_|)scale_opts(=(.+))?$/) { $3 || 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(@ARGV); if ($option eq "index" && $val eq $DEFAULT_INDEX) { undef $DEFAULT_INDEX; } else { $opt{$option} = $val; } } 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; } $dir = $dir || "."; # We'll add the .html flag $opt{'index'} =~ s/\Q$HTML\E$//; $dir =~ s|/$||; # Little cleanup (\%opt,$dir); } ######################### # Quote URLs to avoid errors ######################### sub quote { my ($path,$opt) = @_; $path =~ s/'/%27/g; # Convert ' to %27 $path =~ s/"/%22/g; # Convert " to %22 $path =~ s/#/%23/g; # Convert # to %23 $path = "'$path'"; # And quote the rest return $path unless ($opt && $opt->{'fix_urls'}); # Should probably correct more than just whitespace $path =~ s/(\s)/"%".sprintf("%2.2x",ord($1))/eg; $path; } sub read_captions { my ($opt,$dir) = @_; my %caps; my $caps = $opt->{'captions'}; return unless ($caps); return unless (-r "$dir/$caps"); if (!open(CAPS,"<$dir/$caps")) { print STDERR "[$PROGNAME] Couldn't read captions: [$dir/$caps]"; return; } while () { chomp; my $split_tabs = /\t/ ? 1 : 0; my ($file,$name,$cap,$alt)= $split_tabs ? split(/\t+/, $_, 4) : split(/\s*::\s*/, $_, 4); $name=$file if (!$name && $cap); next unless $file; # && $name; $caps{$file}{name}=$name; $caps{$file}{cap}=$cap if $cap; $caps{$file}{alt}=$alt if $alt; $caps{$file}{num}=$.+1; } close CAPS; \%caps; } # Sort according to order found in optional captions file sub sort_rank { my ($opt,$caps,$dir,$f) = @_; return $caps->{$f} && $caps->{$f}{num} unless $opt->{date_sort}; # Save mod times in a cache return $opt->{DATE_SORT_CACHE}{$f} if $opt->{DATE_SORT_CACHE} && $opt->{DATE_SORT_CACHE}{$f}; $opt->{DATE_SORT_CACHE}{$f} = -M "$dir/$f"; $opt->{DATE_SORT_CACHE}{$f}; } sub caption_order { my ($opt,$caps,$dir,$a,$b) = @_; my $an = sort_rank($opt,$caps,$dir,$a); my $bn = sort_rank($opt,$caps,$dir,$b); # This tries to mingle captioned images with non-captioned. It won't work, # because what do you do if you have images: a, b, c and the captions # file only has c and then a. There's no way to sort that. # return $an <=> $bn if ($an && $bn); # return ($a cmp $b); # This code will put captioned images above non-captioned images if ($an) { return $bn ? ($an <=> $bn) : -1; } else { return $bn ? 1 : ($a cmp $b); } } # Nice name for printing sub clean_name { my ($name,$caps) = @_; return $caps->{$name}{name} if $caps->{$name} && $caps->{$name}{name}; # No tags in filenames :) $name =~ s/\$1 $2" if $name =~ /^(\d{4}-\d{1,2}-\d{1,2})( .+)$/; $name; } sub caption { my ($cap,$capfile) = @_; if (-f $capfile && open(CAP,"<$capfile")) { while() { print; } close CAP; return; # Don't use both captions? } print $cap; } ######################### # Scan ######################### sub scan_album { my ($opt,$dir,@dir_names) = @_; opendir(DIR,$dir); my (@dir) = grep(!/^\.{1,2}$/, readdir(DIR)); closedir(DIR); my $caps_H = read_captions($opt,$dir); $dir_names[-1] = $caps_H->{$dir_names[-1]}{name} if ($caps_H->{$dir_names[-1]}); my @new_dirs = grep(-d "$dir/$_" && !-f "$dir/$_/$HIDE_ALBUM" && !/^CVS|SCCS|RCS|\.xvpics$/ && # Ignore revision/xv dir $_ ne $opt->{dir} && ($opt->{all} || !/^\./), @dir); @new_dirs = sort { caption_order($opt,$caps_H,$dir,$a,$b); } @new_dirs; my $post = $HTML; $post = ".$opt->{index}$post" if $opt->{index} && $opt->{index} ne $DEFAULT_INDEX; opendir(TN,"$dir/tn"); my @pics; map { push(@pics,$1) if /(.+)\Q$post\E$/; } readdir(TN); closedir(TN); @pics = sort { caption_order($opt,$caps_H,$dir,$a,$b); } @pics; if (@pics) { my $dir_name=join('/',@dir_names); my $index = ("$opt->{'index'}" eq "$DEFAULT_INDEX") ? "" : "$opt->{'index'}$HTML"; my $qdir = quote("$dir/$index"); print "$dir_name\n
    \n"; foreach my $pic ( @pics ) { my $url = quote("$dir/$opt->{dir}/$pic$post"); my $name = clean_name($pic,$caps_H); my $cap = $caps_H->{$pic}{cap}; my $capfile = "$dir/$pic"; $capfile =~ s/\.[^\.]+$//; $capfile.=".txt"; print "$name "; caption($caps_H->{$pic}{cap},$capfile); print "
    \n"; } print "
\n"; } map { scan_album($opt,"$dir/$_",@dir_names,$_); } @new_dirs; } ################################################## # Main code ################################################## sub header { my ($dir) = @_; print < Index [$dir]

Photo album index for: $dir

HEADER } sub footer { print <

Generated by $PROGNAME for album FOOTER } sub main { my ($opt,$dir) = parse_args(); my $name = abs_path($dir); $name =~ s|.*/||; my $no_caps; $name = clean_name($name,$no_caps); header($name); scan_album($opt,$dir,$name); footer(); } main();