#! @perl_path@ -w # -*- perl -*- # # create multiple html pages with pictures, thumbnails and dual captions # # $Id: cthumb.in,v 1.19 2002/08/02 22:50:40 cpg Exp $ # # use: cthumb -c > filename.album # then # cthumb filename.album # # Lines starting with a "#" are comments. Empty lines # are comments (unless they are one of the two lines # following the Page or file lines). # # This program is released under the GNU GPL license. # http://www.gnu.org/copyleft/gpl.html # # (C) 1999-2001, Carlos Puchol, cpg@puchol.com # http://puchol.com/cpg/software/cthumb/ use strict; use URI::Escape; use HTML::Entities; use IO::Handle; use POSIX; use Getopt::Std; my $version = "@cthumb_version@"; my $prefix = "@prefix@"; ############################ # public variables ############################ my @options = ( # variable name type command line argument not allowed in file # | | | default value cthumbrc theme # | | | | | album| comment # 0 1 2 3 4 5 6 7 ["Theme" , "string" , "" , "neat-round.theme", " ", " ", "x", "theme"], ["AlbumTitle" , "string" , "" , "Undefined Title" , " ", " ", " ", "title of album"], ["Languages" , "array" , "" , "English" , " ", " ", " ", "languages"], ["NLanguages" , "integer", "l", "1" , " ", " ", " ", "number of languages to use"], ["SlidePictureGeometry" , "array" , "" , "0x0" , " ", "x", " ", "sizes to generate, 0x0 is original size"], ["DefaultSlidePictureGeometry", "string" , "" , "0x0" , " ", "x", " ", "default size to start with"], ["DefaultSlidePictureQuality" , "integer", "" , "80" , " ", "x", " ", "quality of pictures in slides (1-100). High quality -> large file!"], ["PicturesPerRow" , "integer", "f", "4" , " ", " ", " ", "Number of Pictures Per Row"], ["BGColor" , "string" , "" , "#000033" , " ", "t", " ", "background"], ["DecorBGColor" , "string" , "" , "#000000" , " ", "t", " ", "background for decorations"], ["TextColor" , "string" , "" , "#00FFFF" , " ", "t", " ", "text color"], ["CommentColor" , "string" , "" , "#00AAAA" , " ", "t", " ", "'click on the tumbnails' comment color"], ["NoThumbBGColor" , "string" , "" , "#322207" , " ", "t", " ", "film bg color if there is no thumbnail available"], ["LinkColor" , "string" , "" , "#009900" , " ", "t", " ", "link color"], ["VLinkColor" , "string" , "" , "#000000" , " ", "t", " ", "vlink color"], ["ALinkColor" , "string" , "" , "#000000" , " ", "t", " ", "alink color"], ["LinkSize" , "integer", "" , "1" , " ", "t", " ", "thumbnail link size, in pixels"], ["ThumbWidth" , "integer", "x", "120" , " ", "t", " ", "icon width"], ["ThumbHeight" , "integer", "y", "100" , " ", "t", " ", "icon height"], ["ThumbSmoothing" , "integer", "" , "20" , " ", "t", " ", "icon smoothing strength (1-100)"], ["ThumbQuality" , "integer", "" , "80" , " ", "t", " ", "icon quality (1-100)"], ["SlidePictureSmoothing" , "integer", "" , "0" , " ", "c", " ", "slide picture smoothing strength (1-100)"], ["NoMainIndex" , "boolean", "m", "0" , " ", "c", " ", "generate a main index"], ["TextCaptions" , "boolean", "" , "0" , " ", " ", " ", "generate text captions"], ["StoryOn" , "boolean", "" , "0" , " ", "c", " ", "generate story in slide show"], ["MainIndexName" , "string" , "" , "index.shtml" , " ", " ", " ", "name for the main index file - careful in overwriting!"], ["InlineFiles" , "string" , "s", "" , " ", " ", " ", "path to inline files instead server side include"], ["CheckThumbnails" , "boolean", "t", "0" , " ", "c", " ", "should it re-check the thumbnails for width/height? (time consuming)"], ["DisplayKbytes" , "boolean", "" , "0" , " ", "c", " ", "display the size in kb along with the alt comments"], ["DisplayGeometry" , "boolean", "" , "0" , " ", "c", " ", "display the X x Y geometry in the alt comments"], ["DisplayFileDate" , "boolean", "" , "0" , " ", "c", " ", "display the file date in the comments"], ["LocaleFileDate" , "boolean", "" , "0" , " ", "c", " ", "use locale for file date in the comments"], ["AutoSlideShow" , "boolean", "" , "0" , " ", "c", " ", "generate automatic slide show"], ["AutoSlideTime" , "integer", "" , "2" , " ", "c", " ", "delay time (in seconds) for automatic slide show"], ["TitleBgColor" , "string" , "" , "#bbddff", " ", "t", " ", "title font"], ["TitleFont" , "string" , "" , "Arial,Sans Serif", " ", "t", " ", "title font"], ["TitleFontSize" , "string" , "" , "+2" , " ", "t", " ", "title font size"], ["TitleFontColor" , "string" , "" , "#FFFFFF" , " ", "t", " ", "title font color"], ["StoryFont" , "string" , "" , "Arial,Sans Serif", " ", "t", " ", "story font"], ["StoryFontSize" , "string" , "" , "+0" , " ", "t", " ", "story font size"], ["StoryFontColor" , "string" , "" , "#FFFFFF" , " ", "t", " ", "story font color"], ["CaptionFont" , "string" , "" , "Arial,Sans Serif", " ", "t", " ", "caption font"], ["CaptionFontSize" , "string" , "" , "-1" , " ", "t", " ", "caption font size"], ["ThemeDir" , "string" , "" , "." , " ", "c", "x", "theme directory"], ["Decorations" , "array" , "" , "0 0 0 0" , "x", "t", " ", "theme measurement"], ["InsertExif" , "boolean", "" , "0" , " ", "c", " ", "generate automatic Exif info"], ["UseMogrify" , "boolean", "" , "0" , " ", "c", " ", "use mogrify for scaling and rotating - required for image rotation"], ["RecursiveCP" , "string" , "" , "@CPR@" , " ", "x", "x", "'cp -a' for gnu cp, set to 'cp -r' for bsd, else 'rsync -avq'"], ["ImageDir" , "string" , "" , "@themedir@" , " ", "c", "x", "directory where themes are found"], ["HtmlExtension" , "string" , "" , "html" , " ", " ", "x", "files to create - typically html, shtml or php"], ); ############################ # private variables ############################ my $AlbumTitle = ''; my @Languages = (); my $NLanguages = 0; my $PageNumber = 0; my @SlidePictureGeometry = (); my $DefaultSlidePictureGeometry = ''; my $DefaultSlidePictureQuality = ''; my $PicturesPerRow = 0; my $BGColor = ''; my $DecorBGColor = ''; my $TextColor = ''; my $CommentColor = ''; my $NoThumbBGColor = ''; my $LinkColor = ''; my $VLinkColor = ''; my $ALinkColor = ''; my $LinkSize = 0; my $ThumbWidth = 0; my $ThumbHeight = 0; my $ThumbSmoothing = 0; my $ThumbQuality = 80; my $SlidePictureSmoothing = 0; my $NoMainIndex = 0; my $TextCaptions = 0; my $StoryOn = 0; my $MainIndexName = ''; my $InlineFiles = ''; my $CheckThumbnails = 0; my $DisplayKbytes = 0; my $DisplayGeometry = 0; my $DisplayFileDate = 0; my $LocaleFileDate = 0; my $AutoSlideShow = 0; my $AutoSlideTime = 0; my $TitleBgColor = ''; my $TitleFont = ''; my $TitleFontSize = ''; my $TitleFontColor = ''; my $StoryFont = ''; my $StoryFontSize = 0; my $StoryFontColor = ''; my $CaptionFont = ''; my $CaptionFontSize = -1; my $Theme = ''; my $ThemeDir = ''; my @Decorations = (); my $InsertExif = 0; my $UseMogrify = 0; my $RecursiveCP = ''; my $ImageDir = ''; my $HtmlExtension = ''; my %opt = (); # Option flags saved here my $InsertExifUrl = ''; # For broken InsertExif code my $captionattrs=""; # caption attributes, print them only if necessary. this is done # so that themes may have "empty" caption attributes if they want my $regenerate=0; # by default, do not re-generate thumbnails my $HaveImageSizePerlModule=0; # does the user have the Image::Size perl module? (faster) my $header="header.html"; # header name my $footer="footer.html"; # footer name my $thumbtop="top.png"; # top thumbnail frame my $thumbbottom="bot.png"; # bottom thumbnail frame my $thumbleft="left.png"; # left thumbnail frame my $thumbright="right.png"; # right thumbnail frame my $backarrow="back.png"; # back arrow my $navPrev="prev.png"; # previous, for navigation my $navNext="next.png"; # next, for navigation my $pixel="1.gif"; # transparent pixel of 1x1 bit, for missing pictures my $themeprefix = "neat-round.theme"; # flag to indicate if we're parsing a theme my $parsingTheme = 0; # get the name of the file my $cthumb = $0; my %thumbsize = (); # thumbnail size cache my %pictcreate = (); # picture creation cache my $TotalThumbWidth=1; # left + width + right + 2 * linksize { init_options (); &getopt('Hlfxyis', \%opt); if (exists($opt{H})) { # Show synopsis of cthumb keywords print "These are valid cthumb keywords:\n"; foreach my $o (@options) { print " $o->[0]: $o->[7]\n"; print " Data type: '$o->[1]' Default value: '$o->[3]'\n"; my $allowed = ''; my $notallowed = ''; if ($o->[4] eq ' ') { $allowed .= '.cthumbrc, '; } else { $notallowed .= '.cthumbrc, '; } if ($o->[5] eq ' ') { $allowed .= '.album files, '; } else { $notallowed .= '.album files, '; } if ($o->[6] eq ' ') { $allowed .= 'theme files,'; } else { $notallowed .= 'theme files,'; } if ($allowed ne '') { chop($allowed); print " Allowed in $allowed\n"; } if ($notallowed ne '') { chop($notallowed); print " NOT allowed in $notallowed\n"; } if ($o->[2] ne '') { print " May be overridden using option '-$o->[2]'\n"; } } exit 0; } if (! @ARGV ) { print "usage: cthumb [opts] ...\n\n"; print "\t-c : ouput an album file with (*album generation mode*)\n\n"; print "\t-l : do sheet in languages (default $NLanguages)\n"; print "\t-f : go into film mode ( per row - default $PicturesPerRow)\n"; print "\t-r: force re-generation of all thumbnails\n"; print "\t-x : thumbnail width\n"; print "\t-y : thumbnail height\n"; print "\t-m: don't generate a main index file\n"; print "\t-i : image directory\n"; print "\t-s : inline header.html and footer.html from directory\n"; print "\t-t: check the thumbnail width/height? time consuming. (def: $CheckThumbnails)\n"; print "\n\tcthumb $version. cpg+cthumb\@nospam.puchol.com\n"; print "\thttp://puchol.com/cpg/software/cthumb/\n"; exit -1; } do_cthumbrc(); if ($opt{c}) { # create a plain album &cmd_line_options(); do_album(\@ARGV); exit 0; } my $pwd = `pwd`; chop $pwd; if ($cthumb !~ /^\//) { $cthumb = $pwd . "/" . $cthumb; } print "cthumb $version, running in $pwd\n"; if ($opt{i}) { # image dir $ImageDir = $opt{i}; } for (@ARGV) { do_file($_); } } exit 0; ## subroutines # ========================================================================= # Description: # Reset variables in @options with values set in ~/.cthumbrc. # In: # - # Out: # - # Return: # - # sub do_cthumbrc { my $rc = $ENV{HOME} . "/.cthumbrc"; if (open (RC, $rc)) { while () { if (/^#/) { next; } # Skip comments &parse_option(); } close (RC); } } sub cmd_line_options { if ($opt{l}) { # number of languages $NLanguages = int ($opt{l}); } if ($NLanguages < 1) { $NLanguages = 1; } if ($opt{f}) { # film mode - pictures per film row $PicturesPerRow = int ($opt{f}); } if ($PicturesPerRow < 1) { $PicturesPerRow = 1; } if ($opt{x}) { # thumbnail width my $x = int ($opt{x}); if ($x > 2) { $ThumbWidth = $x; } } if ($opt{y}) { # thumbnail height my $y = int ($opt{y}); if ($y > 2) { $ThumbHeight = $y; } } if ($opt{r}) { # force re-generation of thumbnails $regenerate=1; } if ($opt{m}) { # do not generate main index file $NoMainIndex=1; } if ($opt{s}) { # inline header.html and footer.html $InlineFiles=$opt{s}; } if ($opt{t}) { # check the thumbnails width/height? $CheckThumbnails=1; } } # ========================================================================= # Description: # Create all variables listed in the @options array with their # default value. # In: # - # Out: # - # Return: # - # sub init_options { my $i = 0; # loop all options and initialize them for (@options) { if ($options[$i][1] eq "string" || $options[$i][1] eq "integer" || $options[$i][1] eq "boolean") { eval "\$$options[$i][0] = \"$options[$i][3]\""; } if ($options[$i][1] eq "array") { eval "\@$options[$i][0] = (split (' ', \$options[$i][3]))"; } $i++; } } # ========================================================================= # Description: # Update variables listed in the @options array with the value set in the # various files. # In: # $_ # Out: # - # Return: # 1 found # 0 not found # sub parse_option { my $i = 0; my $found = 0; my $pattern = ""; # loop all options and reset them with value found LOOP: for my $opt (@options) { $pattern = $options[$i][0]; my $cmdopt = "opt{$options[$i][2]}"; my $allowedInTheme = $options[$i][6] eq " "; if (/^($pattern):/i) { $found = 1; if ($parsingTheme && (!$allowedInTheme)) { # ignore setting not allowed in theme return 1; } # if ($cmdopt ne "" && $$cmdopt) { # # do not override command line argument # last LOOP; # } # reset the variable if (($options[$i][1] eq "integer" || $options[$i][1] eq "boolean") && /^$pattern:\s*(\d+)/i) { # integer/boolean w/ or w/o comment eval "\$$options[$i][0] = int($1)"; last LOOP; } if ($options[$i][1] eq "string" && /^$pattern:\s*(.*)\s*?$/i) { # string w/o comment eval "\$$options[$i][0] = \"$1\""; last LOOP; } if ($options[$i][1] eq "array" && /^$pattern:\s*(.*)\s*?$/i) { # array w/o comment eval "\@$options[$i][0] = (split (' ', \$1))"; # if the Languages variable has been assigned -> NLanguages if ($options[$i][0] eq "Languages") { $NLanguages = $#Languages + 1; # print "DEBUG: NLanguages: $NLanguages\n"; } last LOOP; } # print "DEBUG: $pattern = $1 ($cmdopt)\n"; last LOOP; } $i++; } if ($found && ($pattern =~ /^Theme$/i)) { # if a new theme has been assigned, read it now. &read_theme($Theme); } return $found; } sub read_theme { my $newtheme = shift; my $newthemedir = $ThemeDir; # clean the new theme directory name chomp $newtheme; chomp $newthemedir; $newthemedir .= "/" if ($newthemedir !~ /\/$/); $newthemedir = "" if ($newthemedir eq "./"); $newtheme .= ".theme" if (!($newtheme =~ /.theme$/)); $themeprefix = $newthemedir . $newtheme; # reset the new them directory to a real path $newthemedir = "." if ($newthemedir eq ""); # print "DEBUG: \ImageDir: \"$ImageDir\" \$newtheme: \"$newtheme\" \$newthemedir: \"$newthemedir\"\n"; # if the originals exist, update or create the local copy if ((-e ($newthemedir . $newtheme)) || (-e ($ImageDir . "/" . $newtheme . "/"))) { $Theme = $newtheme; # print "DEBUG: $RecursiveCP $ImageDir/$newtheme $newthemedir\n"; system("$RecursiveCP $ImageDir/$newtheme $newthemedir"); } else { print "WARNING: cannot find theme \"$newtheme\" in current directory or in $ImageDir.\n"; print "proceeding with defaults in \"$Theme\" ...\n"; $themeprefix = $Theme; } my $conf = $themeprefix . "/theme.conf"; if (!open (THEME, "<$conf")) { print "WARNING: cannot read \"$conf\" ... proceeding with defaults..\n"; } else { $parsingTheme = 1; while () { &parse_option(); } $parsingTheme = 0; } $backarrow = "" unless (-e "$themeprefix/$backarrow"); } sub initial_checks { # &read_theme($Theme); &cmd_line_options(); $TotalThumbWidth = $ThumbWidth + $Decorations[3] + $Decorations[2] + 2 * $LinkSize; # print "TotalThumbWidth: " . $TotalThumbWidth . "\n"; if ($CheckThumbnails) { eval "require Image::Size"; if (defined $Image::Size::VERSION) { $Image::Size::VERSION = $Image::Size::VERSION; $HaveImageSizePerlModule=1; } } } sub do_file { my @title=(); my $basename=""; my $date=""; my $descindex = ""; my $descfname = $_; my $maintheme; my $recursive_album; my $npics; my $theme; /^(.*?)(\.desc|\.txt|\.album)?$/; $descindex = $1; if ($MainIndexName eq "") { $MainIndexName = $descindex . "-index.$HtmlExtension"; } my $indextmp = "/tmp/.$descindex.tmp.$$"; if (!open (ALBUM, "<$descfname")) { print "cthumb: cannot open file \"$descfname\": $!\n"; exit -1; } open HTMLINDEX, ">$indextmp" || print "cthumb warning: cannot open $indextmp for writing: $!\n"; while () { next if (&parse_option()); if (/^Page/i) { my $line = $_; # all the options are processed: begin the show! &initial_checks(); # for debugging purposes, to dump the variable settings # do_album(()); print HTMLINDEX index_html_header($AlbumTitle); $maintheme = $Theme; $theme = $Theme; $captionattrs .= " face=\"$CaptionFont\"" if ($CaptionFont ne ""); $captionattrs .= " size=\"$CaptionFontSize\"" if ($CaptionFontSize); $_ = $line; goto RESTART; } } exit 0; while () { RESTART: last if eof ALBUM; if (/^Page(\s*(\(([^)]*)\)?)\s*)?\s*:\s*((.*\/)?(.*\.album))\s*$/i) { # this entry is actually an album itself. run cthumb recursively. my $newdir = "."; if (defined($5)) { $newdir = $5; } # print "forking cthumb to: $newdir; perl $cthumb $6\n"; system("cd $newdir > /dev/null; perl $cthumb $6"); # TO-DO: figure out how we can get info from that forked cthumb for: # - number of pictures # - title of the album just generated # - name of the index files, per language $basename = $newdir . "index"; $date = $3; $recursive_album = 1; $PageNumber++; } elsif (/^Page(\s*(\(([^)]*)\)?)\s*)?\s*:\s*((.*)\s*,\s*)?(.*?)(\.s?html)?\s*$/i) { $basename = $6; if (defined($5)) { $theme = $5; } $date = $3; $recursive_album = 0; $PageNumber++; } else { next; } #print "Theme: $theme\n"; last if eof ALBUM; for my $i (1..$NLanguages) { $_ = ; last if (/^(Page|\s*[-<>] )/); # skip if a picture or page found if (/^\s+(.*?)\s*$/) { $title[$i] = $1; } last if eof ALBUM; } last if eof ALBUM; if ($recursive_album ne 1) { # if not an album, generate pages my $npics_created = create_page_html(*ALBUM, $basename, \@title, $date, $theme); $npics = $npics_created . " pictures"; } else { # if al album, do not generate a new page! $npics = "album"; } $theme = $maintheme; # reset theme print HTMLINDEX create_index_entry($basename, \@title, $npics, $date); last if eof ALBUM; goto RESTART; } close ALBUM; print HTMLINDEX &html_footer(); close HTMLINDEX; if ($NoMainIndex) { unlink($indextmp); } else { local $ENV{SHELL}='/bin/sh'; system ("diff $indextmp $MainIndexName >/dev/null 2>/dev/null"); my $difret = $? >> 8; if ($difret != 0) { print "Index for $descfname in: $MainIndexName\n"; my $cmd = "mv $indextmp $MainIndexName"; if (system($cmd)) { print "cthumb warning: command '$cmd' failed: $!\n"; } } else { unlink($indextmp); } } } # # Update one file *only if necessary* # sub update_html_one { my $fname=shift; my $text=shift; my $previous_html=""; if (! -e $fname) { # doesn't exist - create it open OUT, ">$fname"; print OUT $text; close OUT; print "Creating page:\t$fname\n"; return; } open IN, "<$fname"; while () { # suck it all in a variable $previous_html .= $_; } close IN; if ($text eq $previous_html) { # no need to update - don't screw any caching # print "Page:\t$fname-$i.html not updated\n"; return; } print "Updating page:\t$fname\n"; open OUT, ">$fname"; print OUT $text; close OUT; } sub index_html_header { my $title=shift; my $str = ""; $str .= "\n"; $str .= "\n\n"; $str .= "\n"; $str .= "\n"; $str .= ""; $str .= &encode_entities($title); $str .= "\n\n"; $str .= "\n"; if (-e "$InlineFiles/$header") { if ($InlineFiles ne "") { $str .= inline_file ("$InlineFiles/$header"); } else { $str .= "
\n"; } } $str .= "
\n"; $str .= "
\n"; $str .= "\n"; $str .= "\n"; $str .= "\n"; if ($NLanguages > 1) { $str .= "\n"; for (@Languages) { $str .= "\n"; } $str .= "\n"; } return $str; } sub create_index_entry { my $fname = shift; my $title = shift; my $npictures = shift; my $date = shift; my $str = ""; my $i=0; my $append = ""; $date = (defined($date)) ? ", $date" : ''; $str .= "\n"; for my $i (1..$NLanguages) { $append = ""; if ($fname !~ /\.s?html$/i) { # if not an html file, guess rationally if ($NLanguages > 1 && -e ($fname . "-$i.$HtmlExtension")) { $append = "-$i.$HtmlExtension"; } elsif (-e ($fname . ".$HtmlExtension")) { $append = ".$HtmlExtension"; } else { $append = ".$HtmlExtension"; # ok, last attempt. hope the html is there! } } $str .= "\n"; } $str .= "\n"; return $str; } sub thumbname { my $pic = shift; # $pic =~ /^(.*?)(\.gif|\.jpg)?$/; $pic =~ m#^(.*/)?([^/]+)\.(gif|tif+|jpe?g)$#i; # use thumb/ subdirectory if it already exists my $base = (defined($1))? $1 : ''; if (-w ($base . "thumb")) { return ($base . "thumb/$2-thumb.jpg"); } else { return $base . $2 . "-thumb.jpg"; } } sub html_footer { my $str = ""; $str .= "
\n"; $str .= ""; $str .= &encode_entities($title); $str .= "
"; $str .= ""; $str .= &encode_entities($_); $str .= "
"; $str .= "\n"; $str .= &encode_entities($$title[$i]); $str .= "
\n[$npictures $date]

\n"; $str .= "
\n"; if (-e $InlineFiles . $footer) { if ($InlineFiles ne "") { $str .= inline_file ($footer); } else { $str .= "
\n"; } } $str .= "\n\n"; return $str; } sub get_pnm { my $name = shift; if (! (-e $name)) { return; } for my $cmd ("djpeg", "pngtopnm", "giftopnm", "tifftopnm") { my $pnm = `$cmd "$name" `; return $pnm unless $?; } return; } sub create_page_html { local *ALBUM = shift; my $basename = shift; my $title = shift; my $date = shift; my $theme = shift; my @picname = (); my @picrotate = (); # one character rotate indicator. '-': no rotation '>': rotate right '<': rotate left. my @desc = (); my @story = (); my $tmp_string = ""; my $i; my $followup="empty\n"; my $npics=0; # &read_theme($theme); goto top; while () { next if /^#/; # skip over comments top: if (/^Page/i) { # horrible hack $followup=$_; # make sure you save the last line! last; } next unless /^\s*([-<>]) \s*(.*?)(:)?\s*$/; # found the next picture $picname[$npics] = $2; $picrotate[$npics]=$1; $npics++; # fill picture description with default values for my $i (1..$NLanguages) { $desc[$i][$npics-1] = "Image $2"; } # fill picture description and story with text from user for my $i (1..$NLanguages) { $_ = ; if (/^(Page|\s*[-<>] )/) { goto top; } /^\s*(.*?)\s*$/; $desc[$i][$npics-1] = $1 unless ($1 eq ''); if ($StoryOn == 1) { $story[$i][$npics-1] = getStoryText ($picname[$npics-1], $i); } last if eof ALBUM; } last if eof ALBUM; } # print "DEBUG: PPR: $PicturesPerRow\n"; my $rows = POSIX::ceil ($npics / $PicturesPerRow); for my $lang (1..$NLanguages) { my $appendage = (($NLanguages > 1) && ($basename !~ /.*\.(s)?html/)) ? "-$lang" : ""; my $fname = "$basename$appendage"; # if it comes with a full file name already, do not append the extension $fname .= ".$HtmlExtension" if ($basename !~ /\.s?html$/i); my $text = ""; # if only one row, maybe we have less pictures than $PicturesPortRow, so we need to adjust $text = html_header($$title[$lang], $date, ($rows > 1) ? $PicturesPerRow : $npics); # Generate reduced sized images (if desired), and slide show web pages. my @linkPictureURLs = (); my @linkURLs = (); generate_slide_show($fname, $$title[$lang], \@picname, \@picrotate, \@{$desc[$lang]}, \@{$story[$lang]}, $appendage, \@linkPictureURLs, \@linkURLs, $themeprefix); my $picnr = 0; for my $j (1..$rows) { my $num_entries = ($j==$rows && ($npics%$PicturesPerRow != 0)) ? ($npics % $PicturesPerRow) : $PicturesPerRow; $text .= html_film_row("$themeprefix/$thumbtop", $Decorations[0], $num_entries) unless ($Decorations[0] == 0); $text .= thumbnails($picnr, \@picname, \@picrotate, \@linkURLs, \@linkPictureURLs, \@desc, $lang, $num_entries); $text .= html_film_row("$themeprefix/$thumbbottom", $Decorations[1], $num_entries) unless ($Decorations[1] == 0); $text .= text_captions($picnr, \@picname, \@desc, $lang, $num_entries) if $TextCaptions; $text .= html_film_sep(); $picnr += $PicturesPerRow; } $text .= html_footer_film(); update_html_one($fname, $text); } # update files only if necessary $_=$followup; # pass the last line out return $npics; } # This function will generate slide show pages with previous and next links # for every picture sub generate_slide_show { my $albumURL = shift; my $albumTitle = shift; my $originalPictureURLArray = shift; my $originalPictureRotateArray = shift; my $pictureDescriptionArray = shift; my $pictureStoryArray = shift; my $slideURLPostfix = shift; my $slidePictureURLArray = shift; my $slideURLArray = shift; my $themePrefix = shift; # Extract the width and height of each desired slide geometry string. # The string is in the form "x". my @scaleGeometryArray; for my $geometry (@SlidePictureGeometry) { push @scaleGeometryArray, [$geometry =~ /^(\S+)x(\S+)$/]; } # Cache the width and height of all the original images. my @originalPictureGeometryArray; for my $originalPictureURL (@$originalPictureURLArray) { push @originalPictureGeometryArray, [get_image_geometry($originalPictureURL) =~ /^(\S+)x(\S+)$/]; } # Search for the existence of the default geometry. This is the geometry # that will be displayed when a thumbnail is clicked. If the geometry is # not located, we will default to the first geometry. my ($defaultWidth, $defaultHeight) = $DefaultSlidePictureGeometry =~ /^(\S+)x(\S+)$/; my $defaultScaleNumber = 0; for my $scaleNumber (0..$#scaleGeometryArray) { my ($width, $height) = @{$scaleGeometryArray[$scaleNumber]}; # Check for a default geometry match. if($width == $defaultWidth && $height == $defaultHeight) { $defaultScaleNumber = $scaleNumber; } } # If the geometry used is not trivial, meaning there is more than one # possible choice, announce which geometry is being used. if ($#scaleGeometryArray > 0) { print "\tusing '" . $scaleGeometryArray[$defaultScaleNumber][0] . "x" . $scaleGeometryArray[$defaultScaleNumber][1] . "' as default slide geometry.\n"; } # Precalculate the slide page URLs so that things like next and previous # links are easy to determine when we generate the HTML later. Also # generate any reduced size images, if they do not already exist. Calculate # and cache any image sizes, geometries, and scale bounding box geometries # to make HTML generation of image attributes easier later. my @generatedPictureURLArrayArray; my @generatedPictureGeometryArrayArray; my @generatedSlideURLArrayArray; for my $pictureNumber (0..$#$originalPictureURLArray) { my $originalPictureURL = $$originalPictureURLArray[$pictureNumber]; my $originalPictureRotate = $$originalPictureRotateArray[$pictureNumber]; my ($path, $filename, $pictureExtension) = split_filename($originalPictureURL); my $outputPath = $path; if (-w "$path/thumb") { $outputPath .= "/thumb"; } my $originalPictureGeometry = $originalPictureGeometryArray[$pictureNumber]; my @generatedPictureURLArray; my @generatedSlideURLArray; my @generatedPictureGeometryArray; my $scaleIndexNumber = 0; for my $scaleGeometry (@scaleGeometryArray) { # Only create a intermediate scaled slide show image if the original # image is larger than the scaled down size, and the user has not # prohibited scaling (i.e. geometry of (0, 0). if ($scaleGeometry->[0] > 0 && $scaleGeometry->[1] > 0 && ($scaleGeometry->[0] <= $originalPictureGeometry->[0] || $scaleGeometry->[1] <= $originalPictureGeometry->[1])) { # Calculate the slide show image name. Slide show images are # postfixed with an index value of their scale bounding # box geometries. For example, "100-0103.jpg" would # be be scaled into "100-0103-1.jpg" # using a 800x600 scale geometry while generating # images for 640x480 800x600 0x0. my $generatedPictureURL = "$outputPath/$filename-" . $scaleIndexNumber . "." . $pictureExtension; # Generate a reduced geometry image from the original image, # but only if it has not been already generated. if($originalPictureRotate eq '-'){ scale_image($originalPictureURL, $generatedPictureURL, $scaleGeometry->[0], $scaleGeometry->[1], "0>", $DefaultSlidePictureQuality, $SlidePictureSmoothing, 0); }elsif($originalPictureRotate eq '>'){ scale_image($originalPictureURL, $generatedPictureURL, $scaleGeometry->[1], $scaleGeometry->[0], "90>", #Note: Width and Height swapped $DefaultSlidePictureQuality, $SlidePictureSmoothing, 0); }elsif($originalPictureRotate eq '<'){ scale_image($originalPictureURL, $generatedPictureURL, $scaleGeometry->[1], $scaleGeometry->[0], "-90>", #Note: Width and Height swapped $DefaultSlidePictureQuality, $SlidePictureSmoothing, 0); } push @generatedPictureURLArray, $generatedPictureURL; push @generatedPictureGeometryArray, [get_image_geometry($generatedPictureURL) =~ /^(\S+)x(\S+)$/]; } else { push @generatedPictureURLArray, $originalPictureURL; push @generatedPictureGeometryArray, $originalPictureGeometry; } # Calculate the slide show web page for the generated image. # Slide show pages follow a similar naming convention to the # slide show images, except they are also postfixed with a # page number and language specifier. # For example, "100-0103-1.jpg" will # be displayed by "100-0103-1-1-1.shtml". push @generatedSlideURLArray, "$outputPath/$filename-" . $PageNumber . "-" . $scaleIndexNumber . $slideURLPostfix . ".$HtmlExtension"; $scaleIndexNumber++; } # Cache the precalculated names in the master caches. # !!! Consider promoting some of these caches for use across all # !!! languages and thumbnail generation. push @generatedPictureURLArrayArray, [@generatedPictureURLArray]; push @generatedPictureGeometryArrayArray, [@generatedPictureGeometryArray]; push @generatedSlideURLArrayArray, [@generatedSlideURLArray]; } # Populate the slide picture and slide URL arrays that the thumbnail # generator will use for links and image reflection. # !!! Consider calculating thumbnail html here since we already have # !!! all the necessary information. @$slidePictureURLArray = (); # delete previous entries @$slideURLArray = (); # delete previous entries for my $pictureNumber (0..$#$originalPictureURLArray) { push @{$slidePictureURLArray}, $generatedPictureURLArrayArray[$pictureNumber][$defaultScaleNumber]; push @{$slideURLArray}, $generatedSlideURLArrayArray[$pictureNumber][$defaultScaleNumber]; } # Retrieve and format the attributes of each slide page and render each in # turn. for my $pictureNumber (0..$#$originalPictureURLArray) { my $pictureDescription = $$pictureDescriptionArray[$pictureNumber]; my $pictureStory = $$pictureStoryArray[$pictureNumber]; my $pictureTimestamp = timestamp($$originalPictureURLArray[$pictureNumber]) or die "Failed to take timestamp of '" . $$originalPictureURLArray[$pictureNumber] . ".\n"; for my $scaleNumber (0..$#scaleGeometryArray) { my $slideURL = $generatedSlideURLArrayArray[$pictureNumber][$scaleNumber]; # Only provide a previous link, if this is not the first image in # the album. my $previousSlideURL = ""; if ($pictureNumber > 0) { $previousSlideURL = $generatedSlideURLArrayArray[$pictureNumber - 1][$scaleNumber]; } # Only provide a next link, if this is not the last image in the # album. my $nextSlideURL = ""; if ($pictureNumber < $#$originalPictureURLArray) { $nextSlideURL = $generatedSlideURLArrayArray[$pictureNumber + 1][$scaleNumber]; } my $pictureURL = $generatedPictureURLArrayArray[$pictureNumber][$scaleNumber]; my $pictureGeometry = $generatedPictureGeometryArrayArray[$pictureNumber][$scaleNumber]; my $pictureSize = int((1023 + -s $pictureURL)/1024); my $pictureTitle = $pictureDescription; if (! $TextCaptions) { (my $urlPath, $pictureTitle, my $urlExtension) = split_filename($$originalPictureURLArray[$pictureNumber]); } # If multiple geometries are requested, generate a multi-geometry # link for the slide page. The link is fitted to the size of the # image with each geometry link evenly spaced along the bottom. # Each link is live to the sister geometry slide pages, except, # of course, the current one. my $geometryLink = ""; if ($#scaleGeometryArray > 0) { my $geometryPercentage = int 100 / ($#scaleGeometryArray + 1); $geometryLink = "\n\n"; for my $linkNumber (0..$#scaleGeometryArray) { $geometryLink .= "\n"; } $geometryLink .= "\n
"; if ($linkNumber != $scaleNumber) { $geometryLink .= ""; } $geometryLink .= $generatedPictureGeometryArrayArray[$pictureNumber][$linkNumber][0]; $geometryLink .= "x"; $geometryLink .= $generatedPictureGeometryArrayArray[$pictureNumber][$linkNumber][1]; if ($linkNumber != $scaleNumber) { $geometryLink .= ""; } $geometryLink .= "
\n"; } # Actually render the slide. generate_slide( $slideURL, $previousSlideURL, $nextSlideURL, $pictureURL, $pictureGeometry, $pictureSize, $pictureTitle, $pictureStory, $pictureTimestamp, $albumURL, $albumTitle, $geometryLink, $themePrefix); } } } # This function is responsible for generating html for a single image that # provides viewing facilities and quick navigation links to adjacent images, # album indices, and possibly an even larger image original. sub generate_slide { my $url = shift; my $previousURL = shift; my $nextURL = shift; my $pictureURL = shift; my $pictureGeometry = shift; my $pictureSize = shift; my $pictureTitle = shift; my $pictureStory = shift; my $originalPictureTimestamp = shift; my $albumURL = shift; my $albumTitle = shift; my $geometryLink = shift; my $themePrefix = shift; STDOUT->autoflush(); # Generate the header and title. my ($urlPath, $urlFileName, $urlExtension) = split_filename($url); my $str = themed_header($urlPath, $pictureTitle); $str .= "
\n"; # Display timestamps, if desired. if ($originalPictureTimestamp ne "" && $DisplayFileDate != 0) { $str .= "$originalPictureTimestamp
\n"; } # Render the navigation controls, "previous", "album index",and # "next" evenly distributed across the top of the picture. $str .= "\n"; $str .= "\n"; $str .= "\n"; $str .= "\n"; $str .= "\n\n
"; if ($previousURL ne "") { $str .= ""; } else { $str .= " "; } $str .= ""; if ($backarrow ne "") { if ($AutoSlideShow) { $str .= ""; } else { $str .= ""; } $str .= "\"Index\"

\n"; } $str .= ""; $str .= ""; $str .= "$albumTitle"; $str .= ""; $str .= "\n"; $str .= "
"; my $relative_next_url = relative_path($url, $nextURL); if ($nextURL ne "") { my $tmpURL = relative_path($url, $nextURL); $str .= ""; $str .= ""; } else { $str .= " "; } $str .= "
\n\n"; if ($AutoSlideShow) { $str .= "
\n"; $str .= "\n"; $str .= "\n"; $str .= "\n"; $str .= "\n"; $str .= "\n"; $str .= " interval in seconds.\n"; $str .= "
\n"; $str .= "
\n"; } # Generate the themed title. $str .= "

"; $str .= $pictureTitle; $str .= "

\n"; # Generate the story. if ($StoryOn == 1 && $pictureStory ne "") { $str .= "

"; $str .= $pictureStory; $str .= "

\n"; } # Render the image directly under the navigation controls. $str .= "
\n\n"; $str .= $geometryLink; $str .= "
\n"; if ($InsertExif == 1){ my $relURL = relative_path($url, $pictureURL); my $exiftxt = "

\n" . `jhead $relURL` . "
"; $exiftxt =~ s/^([^:\n]*[^: \t\n]+)\s*:\s*(.*)$/$1<\/td>$2<\/td><\/tr>/mg; $str .= $exiftxt; } # Generate the footer $str .= themed_footer($urlPath); # Write out the file. update_html_one($url, $str); } sub themed_header { my $path = shift; my $title = shift; my $str = ""; $str .= "\n"; $str .= "\n\n"; $str .= "\n"; $str .= "\n"; $str .= ""; # Encoding title strips out insecure html. This is done in case someone # wishes to run cthum inside a server. $str .= &encode_entities($title); $str .= "\n"; $str .= "\n\n"; $str .= "\n"; if ($AutoSlideShow) { $str .= "\n"; } # If a header exists in the same directory as the slide page or in # the inline directory, incorporate it. if ((-e $InlineFiles . $header) && ($InlineFiles ne "")) { $str .= inline_file ($header); } else { if (-e "$path/$header" && ($InlineFiles eq "")) { $str .= "
\n"; } } $str .= "\n"; return $str; } sub themed_footer { my $path = shift; my $str = ""; # If a footer exists in the same directory as the slide page or in # the inline directory, incorporate it. if (-e $InlineFiles . $footer && ($InlineFiles ne "")) { $str .= inline_file ($footer); } else { if (-e "$path/$footer" && ($InlineFiles eq "")) { $str .= "
\n"; } } $str .= "\n\n"; return $str; } # This function takes two relative paths (not fully qualified URLs) and # calculates the relative path of the second file with respect to the first # file's directory. This function may be in a perl module somewhere, in # which case this should be given up in favor of the more standard one. sub relative_path { my $sourcePath = shift; my $destinationPath = shift; # Reduce the supplied path to its simplest form without redundant # /./foo/../ type paths. $sourcePath = reduce_path($sourcePath); $destinationPath = reduce_path($destinationPath); my $sourceDirectory = ""; my $destinationDirectory = ""; # If the destination is already absolute, simply return it. if ($destinationPath =~ /^\//) { return $destinationPath; } # If the source is absolute, but the destination is not, fail. elsif ($sourcePath =~ /^\//) { die "Cannot resolve path '$sourcePath' from absolute source."; } # Keep shaving off the root directories as long as they match. my ($s, $d); while ((($sourceDirectory, $s) = $sourcePath =~ /([^\/]*)\/(.*)/) && (($destinationDirectory, $d) = $destinationPath =~ /([^\/]*)\/(.*)/) && $sourceDirectory eq $destinationDirectory) { $sourcePath = $s; $destinationPath = $d; } # Generate "../" paths for every directory that we must climb from # the source directory. my $newPath = "."; my $sr; while (($sourceDirectory, $sr) = $sourcePath =~ /([^\/]*)\/(.*)/) { $sourcePath = $sr; $newPath = "$newPath/.."; } # Append the descent into the destination directory. return escape_url(reduce_path("$newPath/$destinationPath")); } # This method eliminates unnecessary '.' and '..' paths to keep them concise # and easily comparable. sub reduce_path { my $path = shift; # Delete "/./", "//", and "dir/../" directories. while ($path =~ s#(/(\.?/)+|/?([^/.]+/\.\./)+)#/#g) { } # Delete leading "./" directories. $path =~ s/^\.\///; return $path; } # This method breaks up a fully qualified filename into its component parts # Examples: # "cthumb/images/100-0104.jpg" -> ("cthumb/images", "100-0104", "jpg") # "100-0104.jpg" -> ("", "100-0104", "jpg") # "./../100-0104.jpg" -> ("./..", "100-0104", "jpg") # "/100-0104.jpg" -> ("/.", "100-0104", "jpg") sub split_filename { my $file = shift; $file =~ /^(.*\/|)([^\/]+)\.([^\/\.]+)$/; my $path = $1; my $fileName = $2; my $extension = $3; # Convert '/' to '/.' $path =~ s/^\/$/\/\./; # Get rid of trailing '/'. $path =~ s/^(.*)\/$/$1/; # Convert '' to '.' $path =~ s/^$/./; return ($path, $fileName, $extension); } # This function url encodes a given url sub escape_url { my $url = shift; $url =~ /^(.*\/|)([^\/]+)$/; my $path = $1; my $fileName = &encode_entities(uri_escape($2)); return "$path$fileName"; } # Generates a line of thumbnails on a thumbnail page. # The line doesn't contain the top and bottom decorations because they are # generated by html_film_row. sub thumbnails { my $first_pic_in_row=shift; my $picname=shift; my $picrotate=shift; my $linkURLs=shift; my $linkPictureURLs=shift; my $desc=shift; my $lang=shift; # number of languages my $npics=shift; # number of pictures to do. my $text .= "\n"; my $pic=0; for my $k (0..($npics-1)) { $pic=$first_pic_in_row+$k; # Open row. $text .= "\n"; # Generate left decoration if ($Decorations[2] >= 0) { if (-e "$themeprefix/$thumbleft") { $text .= "\n"; } else { $text .= "\n"; } } # Generate the thumb image if ($$picname[$pic] eq '') { $text .= ""; } else { $text .= html_pic_film($$picname[$pic],$$picrotate[$pic], $$linkURLs[$pic], $$linkPictureURLs[$pic], $$desc[$lang][$pic]); } # Generate the right decoration. if ($Decorations[3] >= 0) { if (-e "$themeprefix/$thumbright") { $text .= "\n"; } else { $text .= "\n"; } } # Close the row $text .= "



\n"; } for my $k ($npics .. ($PicturesPerRow-1)) { $text .= "\n" } $text .= "\n"; return $text; } sub timestamp { my $picname = shift; if($InsertExif){ my $pictime = "" . `jhead $picname | grep "Date/Time"` . "
"; $pictime =~ s/Date\/Time\s*:\s*//; return $pictime; } else { my @s = stat($picname); my $mtime = $s[9]; if ($LocaleFileDate) { use locale; my $datestr = strftime ("%c
", localtime($mtime)); return $datestr; } else { my @ltime = localtime($mtime); return sprintf "%2d:%02d, %d/%d/%d
", $ltime[2], $ltime[1], 1 + $ltime[4], $ltime[3], 1900 + $ltime[5]; } } } sub text_captions { my $first_pic_in_row=shift; my $picname=shift; my $desc=shift; my $lang=shift; my $npics=shift; # number of pictures to do. my $text .= "\n"; my $pic=0; for my $k (0 .. ($npics-1)) { $pic=$first_pic_in_row+$k; if ($$picname[$pic] eq '') { $text .= "\n"; } else { $text .= ""; $text .= ""; $text .= timestamp($$picname[$pic]) if ($DisplayFileDate != 0); $text .= $$desc[$lang][$pic]; $text .= ""; $text .= "\n"; } } for my $k ($npics .. ($PicturesPerRow-1)) { $text .= "" } $text .= "\n"; return $text; } # Generates top or bottom parts for a row of thumbnails sub html_film_row { my $image=shift; my $height=shift; my $npics=shift; # number of pictures to do. my $i; my $img=""; # of row image, just to keep aspect ratio return "" if ($image eq ""); $image =~ /(.*)\.png$/; my $prefix = $1; my $str = "\n"; for my $i (1..$npics) { $img = $prefix . "-" . $i . ".png"; if (!(-e $img)) { $img = $prefix . ".png"; } $str .= "\"\"\n"; } for my $i ($npics+1..$PicturesPerRow) { # fill the rest $str .= "\n"; } $str .= "\n"; return $str; } sub html_film_sep { return "
\n"; } sub html_header { my $title=shift; my $date=shift; my $str = ""; my $npics=shift; # number of pictures to do. $str .= themed_header(".", $title); if (! (defined($date))) { $date = ''; } # Generate the themed title. $str .= "
\n"; if ((!$NoMainIndex) && ($backarrow ne "")) { $str .= "\"Index\"

\n"; } $str .= "" unless $NoMainIndex; $str .= ""; $str .= "$title"; $str .= ""; $str .= "" unless $NoMainIndex; $str .= "
\n"; $str .= "[$date]" unless ($date eq ""); $str .= "

\n\n"; $str .= "

\n"; return $str; } sub html_footer_film { my $str = ""; $str .= "

\n"; $str .= "
\n"; if (-e $InlineFiles . $footer) { if ($InlineFiles ne "") { $str .= inline_file ($footer); } else { $str .= "
\n"; } } $str .= "\n\n"; return $str; } sub get_image_size { my $picname=shift; my $picrotate=shift; my $thumb=shift; # open thumb, unless not requested to if (defined($thumbsize{$thumb})) { # print "\t$thumb: $thumbsize{$thumb}\n"; return $thumbsize{$thumb}; } # this is yet another alternative. just as fast as the rdjpeg # return Image::Size::html_imgsize($thumb) if ($HaveImageSizePerlModule); # # this is an alternative (probably the slowest) to the code below # # all the options below are intended to make it fast - we only need the size! # open THUMB, "djpeg -dct fast -nosmooth -onepass -fast -grayscale -pnm \"$thumb\" |"; # $_ = ; #read first line and discard # $_ = ; # read second with the width and height # /(\d+)\s+(\d+)/; # close THUMB; # $twh = "width=$1 height=$2"; # check the cache, since the thumbs are probably done once per language. # i.e. for two languages, this provides a 100% improvement in speed my $twh = ""; my $cmd = "rdjpgcom -verbose " . "\"$thumb\" |"; open (THUMB, $cmd ) || die "Unable to issue cmd: '$cmd' : $!"; do { $_ = ; #read first line and discard if (/^JPEG image is (\d+)w \* (\d+)h/) { # the next two lines, fake the thumbnail size, if bigger than the theme my $w = $1; my $h = $2; $w = $ThumbWidth if ($w > $ThumbWidth); $h = $ThumbHeight if ($h > $ThumbHeight); if (($1 > $ThumbWidth) || ($2 > $ThumbHeight)) { print "$thumb: too big ($1 x $2), theme is ($ThumbWidth x $ThumbHeight) ... re-generating.\n"; print "$thumb: please re-run cthumb to pick up new size.\n"; # &scale_image($picname, $thumb, 1) if $RegenerateThumbIfBigger; if($picrotate eq '-'){ scale_image($picname, $thumb, $ThumbWidth, $ThumbHeight, "0>", $ThumbQuality, $ThumbSmoothing, 1); }elsif($picrotate eq '>'){ # Even thoug rotated, Width and Height are kept to make bounding box fit theme scale_image($picname, $thumb, $ThumbWidth, $ThumbHeight, "90>", $ThumbQuality, $ThumbSmoothing, 1); }elsif($picrotate eq '<'){ # Even thoug rotated, Width and Height are kept to make bounding box fit theme scale_image($picname, $thumb, $ThumbWidth, $ThumbHeight, "-90>", $ThumbQuality, $ThumbSmoothing, 1); } } $twh = "width=\"$w\" height=\"$h\""; $thumbsize{$thumb} = $twh; goto closethumb; } } while (!eof(THUMB)); closethumb: close THUMB; return $twh; } sub scale_image { my $src = shift; my $dest = shift; my $destWidth = shift; my $destHeight = shift; my $destRotate = shift; my $quality = shift; my $smoothingStrength = shift; my $force = shift; if (defined($pictcreate{$dest})) { # if already created in this run, just return. return; } # if the destination file does not exist, or the picture is newer or # the re-generate option has been given, then create it if (!((! (-e $dest)) || (((stat($dest))[9]) < ((stat($src))[9])) || $regenerate || $force)) { # mark in the cache that we have it $pictcreate{$dest} = 1; return; } print "\tgenerating $dest ... "; if ($UseMogrify) { system "cp $src $dest"; my $cmd = "mogrify -rotate \"$destRotate\" -geometry \"${destWidth}x${destHeight}>\" -quality $quality"; if ($InsertExif){ my $new_cmd = "jhead -cmd '$cmd &i' $dest"; if (system($new_cmd)) { print "cthumb warning: command '$new_cmd' failed: $!\n"; } else {print "done.\n";} } else { my $new_cmd = "$cmd $dest"; if (system($new_cmd)) { print "cthumb warning: command '$new_cmd' failed: $!\n"; } else {print "done.\n";} } } else { STDOUT->autoflush(); my $pnm = ""; if (!($pnm = &get_pnm($src))) { die "Cannot scale image `$dest`."; } # make pnmscale shut up (version in redhat 7.2 # spits out stuff to stderr, even without -verbose, arggh) my $cmd = "| pnmscale -xy $destWidth $destHeight 2> /dev/null | "; $cmd .= "cjpeg -progressive -optimize "; if ($smoothingStrength) { $cmd .= "-smooth $smoothingStrength "; } $cmd .= "-outfile \"$dest\""; if (open PNMTOTHUMB, $cmd) { print PNMTOTHUMB $pnm; close PNMTOTHUMB; print "done.\n"; } else { die "Cannot scale image `$dest`."; } } # once created, mark in the cache that we have it $pictcreate{$dest} = 1; } sub get_image_geometry { my $picname = shift; my $cmd; my $width = 0; my $height = 0; if ($picname =~ /\.jpe?g$/i) { open FILE, "rdjpgcom -verbose \"$picname\" |" or return ""; while () { if (/^JPEG image is (\d+)w \* (\d+)h/) { $width = $1; $height = $2; close FILE; return "$width" . "x" . "$height"; } } return ""; } if ($picname =~ /\.gif$/i) { open FILE, "giftopnm \"$picname\" | pnmfile |" or return ""; $_ = ; if (/^stdin:\s+PPM raw, (\d+) by (\d+)/) { $width = $1; $height = $2; close FILE; return "$width" . "x" . "$height"; } } return ""; } sub html_pic_film { my $picname=shift; my $picrotate=shift; my $linkURL=shift; my $linkPictureURL=shift; my $desc=shift; my $str = "Thumbnail failed.
"; my $thumb = thumbname($picname); if ($picrotate eq '-'){ scale_image($picname, $thumb, $ThumbWidth, $ThumbHeight, "0>", $ThumbQuality, $ThumbSmoothing, 0); } elsif ($picrotate eq '>'){ scale_image($picname, $thumb, $ThumbWidth, $ThumbHeight, "90>", $ThumbQuality, $ThumbSmoothing, 0); } elsif ($picrotate eq '<'){ scale_image($picname, $thumb, $ThumbWidth, $ThumbHeight, "-90>", $ThumbQuality, $ThumbSmoothing, 0); } my $twh = ""; if ($CheckThumbnails) { $twh = " " . &get_image_size($linkPictureURL, $picrotate, $thumb); } my $size = int((1023 + -s $linkPictureURL)/1024); $desc = alt_cleanup($desc); my $wh = " width=" . ($ThumbWidth+2*$LinkSize) . " height=" . ($ThumbHeight+2*$LinkSize); $str = "\n"; if ($AutoSlideShow) { $str .= "\n"; } else { $str .= "\n"; } $str .= "\n"; return $str; } # ========================================================================= # Description: # Create an album file. # In: # files # Out: # - # Return: # - # sub do_album { my $i = 0; my $files=shift; my $lang="Language"; # generic language name print "#\n# Automatically generated by cthumb on " . `date`; print "#\n# cthumb $version. cthumb-devel\@lists.sourceforge.net\n"; print "# http://puchol.com/cpg/software/cthumb/\n"; print "#\n# All allowed variables are listed below, with their defaults\n"; print "#\n\n"; for my $opt (@options) { if ($options[$i][5] eq "x") { $i++; next; } my $comment = ($options[$i][5] eq "c") ? "# " : (($options[$i][5] eq "t")? "# typically in themes only - recommend not to use\n# " : "" ); if ($options[$i][1] ne "array") { eval "print \"# $options[$i][7]\n$comment$options[$i][0]: \$$options[$i][0]\n\n\""; } else { eval "print \"# $options[$i][7]\n$comment$options[$i][0]: \@$options[$i][0]\n\n\""; } $i++; } print "\n"; print "# Image files are preceded by '-', '>', and '<' on lines below. '>' and '<' indicates rotation.\n"; print "\n"; print "Page: page\n"; for my $i (0..($NLanguages-1)) { my $l = " in " . (($i > $#Languages) ? $lang . ($i + 1) : $Languages[$i]); $l = "" unless ($NLanguages > 1); print "\t\tThis is the Title for Page 1" . $l . "\n"; } for (@$files) { print "\n\t- $_\n"; for my $i (0..($NLanguages-1)) { print "\t\t$_\n"; } } } sub inline_file { my $filename = shift; $filename = $InlineFiles . $filename; my $s = ""; open (FH, $filename) or return ("<--! Can't open file " . $filename . ". -->\n"); my $line; while (defined($line = )) { $s .= $line; } close (FH); return $s } sub alt_cleanup { my $desc = shift; $desc =~ s/
/ /ig; # try to clean standard stuff $desc =~ s/<[^>]*>//g; # try to remove other artifacts $desc =~ s/\"/\"/g; # quote quotes return $desc; } # ========================================================================= # Description: # Return the content of the file "picture name.language" as a string. # HTML content will be encoded. # Language is ALWAYS expected to be in lower case! # Look for the file in the current directory. # If the file does not exist, return an empty string. # In: # picture name # language # Out: # - # Return: # "" if no file found # file content as string # sub getStoryText { my $picname = shift; my $nlang = shift; my $language = lc $Languages[$nlang-1]; my $storyname = $picname . "." . $language; my $s = ""; my $line = ""; if (open (STORY, $storyname)) { while (defined($line = )) { $s .= $line; } close (STORY); $s = &encode_entities ($s); } return $s; }