attempt to support utf8 better
[mkgallery.git] / mkgallery.pl
index 7efd5c4209209b42e03497f7b6ae9ee29e23bad2..8bed35cb1d594efd3fdb17cb7703751757ddb198 100755 (executable)
@@ -1,12 +1,12 @@
 #!/usr/bin/perl
 
-# $Id$
+my $version='$Id$';
 
 # Recursively create image gallery index and slideshow wrappings.
 # Makes use of modified "slideshow" javascript by Samuel Birch
 # http://www.phatfusion.net/slideshow/
 
-# Copyright (c) 2006-2008 Eugene G. Crosser
+# Copyright (c) 2006-2013 Eugene G. Crosser
 
 #  This software is provided 'as-is', without any express or implied
 #  warranty.  In no event will the authors be held liable for any damages
@@ -29,30 +29,31 @@ package FsObj;
 use strict;
 use Carp;
 use POSIX qw/getcwd strftime/;
+use HTTP::Date;
 use CGI qw/:html *table *Tr *td *center *div *Link/;
 use Image::Info qw/image_info dim/;
 use Term::ReadLine;
 use Getopt::Long;
 use Encode;
-use encoding 'utf-8';
+use UUID;
+use utf8;
 binmode(STDOUT, ":utf8");
 
 my $haveimagick = eval { require Image::Magick; };
 { package Image::Magick; }     # to make perl compiler happy
 
-my $haverssxml = eval { require XML::RSS; };
-{ package XML::RSS; }          # to make perl compiler happy
+my $havegeoloc = eval { require Image::ExifTool::Location; };
+{ package Image::ExifTool::Location; } # to make perl compiler happy
 
 my @sizes = (160, 640, 1600);
+my $incdir = ".gallery2";
 
 ######################################################################
 
 my $incpath;
-my $rssobj;
 my $debug = 0;
 my $asktitle = 0;
 my $noasktitle = 0;
-my $rssfile = "";
 
 charset("utf-8");
 
@@ -61,33 +62,26 @@ unless (GetOptions(
                'incpath'=>\$incpath,
                'asktitle'=>\$asktitle,
                'noasktitle'=>\$noasktitle,
-               'rssfile=s'=>\$rssfile,
                'debug'=>\$debug)) {
        &help;
 }
 
-if ($rssfile && ! $haverssxml) {
-       print STDERR "You need to get XML::RSS from CPAN to use --rssfile\n";
-       exit 1;
-}
-
 my $term = new Term::ReadLine "Edit Title";
+binmode($term->IN, ':utf8');
 
 FsObj->new(getcwd)->iterate;
-if ($rssobj) { $rssobj->{'rss'}->save($rssobj->{'file'}); }
 
 sub help {
 
        print STDERR <<__END__;
 usage: $0 [options]
  --help:        print help message and exit
- --incpath:     do not try to find .gallery2 diretory upstream, use
+ --incpath:     do not try to find .gallery2 directory upstream, use
                 specified path (absolute or relavive).  Use with causion.
  --debug:       print a lot of debugging info to stdout as you run
  --asktitle:    ask to edit album titles even if there are ".title" files
  --noasktitle:  don't ask to enter album titles even where ".title"
                 files are absent.  Use partial directory names as titles.
- --rssfile=...:        build RSS feed for newly added "albums", give name of rss file
 __END__
 
        exit 1;
@@ -101,14 +95,15 @@ sub new {
                $class = ref($this);
                my $parent = $this;
                my $name = shift;
-               my $fullpath = $parent->{-fullpath}.'/'.$name;
                $self = {
                                -parent=>$parent,
                                -root=>$parent->{-root},
+                               -toppath=>$parent->{-toppath},
+                               -depth=>$parent->{-depth}+1,
                                -base=>$name,
-                               -fullpath=>$fullpath,
+                               -fullpath=>$parent->{-fullpath}.'/'.$name,
+                               -relpath=>$parent->{-relpath}.$name.'/',
                                -inc=>'../'.$parent->{-inc},
-                               -rss=>'../'.$parent->{-rss},
                        };
        } else {
                $class = $this;
@@ -116,9 +111,9 @@ sub new {
                $self = {
                                -root=>$root,
                                -fullpath=>$root,
-                               -inc=>getinc($root),
-                               -rss=>getrss($root),
                        };
+               # fill in -inc, -relpath
+               initpaths($self); # we are not blessed yet, so cheat.
        }
        bless $self, $class;
        if ($debug) {
@@ -130,51 +125,46 @@ sub new {
        return $self;
 }
 
-sub getinc {
-       my $fullpath=shift;     # this is not a method
+sub initpaths {
+       my $self=shift;         # this is not a method but we cheat
        my $depth=20;           # arbitrary max depth
+       my $fullpath=$self->{-fullpath};
+       my $inc;
+       my $relpath;
 
        if ($incpath) {
-               return $incpath."/.gallery2";
-       }
-
-       my $inc=".gallery2";
-       while ( ! -d $fullpath."/".$inc ) {
-               $inc = "../".$inc;
-               last unless ($depth-- > 0);
-       }
-       if ($depth > 0) {
-               return $inc.'/';                # prefix with trailing slash
+               $inc = $incpath;
+               $inc .= '/' unless ($inc =~ m%/$%);
        } else {
-               return 'NO-.INCLUDE-IN-PATH/';  # won't work anyway
-       }
-}
-
-sub getrss {
-       my $fullpath=shift;     # this is not a method
-       my $depth=20;           # arbitrary max depth
-
-       return "" unless $rssfile;
-
-       my $rss=$rssfile;
-       while ( ! -f $fullpath."/".$rss ) {
-               $rss = "../".$rss;
-               last unless ($depth-- > 0);
+               $inc="";
+               while ( ! -d $fullpath."/".$inc."/".$incdir ) {
+                       $inc = "../".$inc;
+                       last unless ($depth-- > 0);
+               }
        }
        if ($depth > 0) {
-               $rssobj->{'file'} = $rss;
-               $rssobj->{'rss'} = new XML::RSS (version=>2);
-               $rssobj->{'rss'}->parsefile($rss);
-               my $itemstodel = @{$rssobj->{'rss'}->{'items'}} - 15;
-               while ($itemstodel-- > 0) {
-                       pop(@{$rssobj->{'rss'}->{'items'}})
+               $self->{-inc} = $inc;
+               my $dp=0;
+               my $pos;
+               for ($pos=index($inc,'/');$pos>=0;
+                                       $pos=index($inc,'/',$pos+1)) {
+                       $dp++;
+               }
+               $self->{-depth} = $dp;
+               for ($pos=length($fullpath);$dp>0 && $pos>0;
+                                       $pos=rindex($fullpath,'/',$pos-1)) {
+                       $dp--;
                }
-               $rssobj->{'rss'}->save($rssobj->{'file'});
-               return $rss;
+               my $relpath = substr($fullpath,$pos);
+               $relpath =~ s%^/%%;
+               $relpath .= '/' if ($relpath);
+               $self->{-relpath} = $relpath;
+               $self->{-toppath} = substr($fullpath,0,$pos);
+               #print "rel=$relpath, top=$self->{-toppath}, inc=$inc\n";
        } else {
-               print STDERR "There is no $rssfile in this or parent ".
-                       "directories, you must create one with mkgalrss.pl\n";
-               exit 1;
+               $self->{-inc} = 'NO-.INCLUDE-IN-PATH/'; # won't work anyway
+               $self->{-relpath} = '';
+               $self->{-depth} = 0;
        }
 }
 
@@ -292,6 +282,16 @@ sub isimg {
        my $self = shift;
        my $fullpath = $self->{-fullpath};
        return 0 unless ( -f $fullpath );
+
+       if ($havegeoloc) {
+               my $exif = new Image::ExifTool;
+               $exif->ExtractInfo($fullpath);
+               my ($la,$lo) = $exif->GetLocation();
+               if ($la && $lo) {
+                       $self->{-geoloc} = [$la,$lo];
+               }
+       }
+
        my $info = image_info($fullpath);
        if (my $error = $info->{error}) {
                if (($error !~ "Unrecognized file format") &&
@@ -357,28 +357,37 @@ sub edittitle {
        my $self = shift;
        my $fullpath = $self->{-fullpath};
        my $title;
+       my $titleimage;
        my $T;
-       if (open($T,'<'.$fullpath.'/.title')) {
+       my $TI;
+       if (open($T,'<:encoding(utf8)', $fullpath.'/.title')) {
                $title = <$T>;
                $title =~ s/[\r\n]*$//;
                close($T);
        }
        if ($asktitle || (!$title && !$noasktitle)) {
-               my $prompt = $self->{-base};
+               my $prompt = $self->{-relpath};
                $prompt = '/' unless ($prompt);
                my $OUT = $term->OUT || \*STDOUT;
                print $OUT "Enter title for $fullpath\n";
                $title = $term->readline($prompt.' >',$title);
                $term->addhistory($title) if ($title);
-               if (open($T,'>'.$fullpath.'/.title')) {
+               if (open($T,'>:encoding(utf8)', $fullpath.'/.title')) {
                        print $T $title,"\n";
                        close($T);
                }
        }
        unless ($title) {
-               $title=substr($fullpath,length($self->{-root}));
+               $title=$self->{-relpath};
        }
        $self->{-title}=$title;
+       if (open($TI,'<:encoding(utf8)', $fullpath.'/.titleimage')) {
+               $titleimage = <$TI>;
+               $titleimage =~ s/[\r\n]*$//;
+               close($TI);
+               #print STDERR "found title image \"",$titleimage,"\"\n";
+               $self->{-titleimage}=$titleimage;
+       }
        print "title in $fullpath is $title\n" if ($debug);
 }
 
@@ -443,7 +452,7 @@ sub makeaux {
        my $dn = $self->{-parent}->{-fullpath};
        my $pref = $self->{-previmg}->{-base};
        my $nref = $self->{-nextimg}->{-base};
-       my $inc = $self->{-inc};
+       my $inc = $self->{-inc}.$incdir.'/';
        my $title = $self->{-info}->{'Comment'};
        $title = $name unless ($title);
 
@@ -476,11 +485,10 @@ sub makeaux {
                                $toggletext = 'Play-&gt;';
                        }
                        my $F;
-                       unless (open($F,'>'.$fn)) {
+                       unless (open($F,'>:encoding(utf8)', $fn)) {
                                warn "cannot open \"$fn\": $!";
                                next;
                        }
-                       binmode($F, ":utf8");
                        if ($refresh eq 'slide') {
                                print $F start_html(
                                        -encoding=>"utf-8",
@@ -489,14 +497,16 @@ sub makeaux {
                                        -head=>meta({-http_equiv=>'Refresh',
                                                -content=>"3; url=$fwdref"}),
                                        -style=>{-src=>$inc."gallery.css"},
-                                       ),"\n";
+                                       ),"\n",
+                                       comment("Created by ".$version),"\n";
                                                
                        } else {
                                print $F start_html(-title=>$title,
                                        -encoding=>"utf-8",
                                        -bgcolor=>"#808080",
                                        -style=>{-src=>$inc."gallery.css"},
-                                       ),"\n";
+                                       ),"\n",
+                                       comment("Created by ".$version),"\n";
                        }
                        print $F start_table({-class=>'navi'}),start_Tr,"\n",
                                td(a({-href=>"../index.html"},"Index")),"\n",
@@ -507,7 +517,9 @@ sub makeaux {
                                end_Tr,
                                end_table,"\n",
                                center(table({-class=>'picframe'},
-                                       Tr(td(img({-src=>$imgsrc}))))),"\n",
+                                       Tr(td(img({-src=>$imgsrc,
+                                                  -class=>'standalone',
+                                                  -alt=>$title}))))),"\n",
                                end_html,"\n";
                        close($F);
                }
@@ -517,7 +529,7 @@ sub makeaux {
        my $fn = sprintf("%s/.html/%s-info.html",$dn,$name);
        if (isnewer($self->{-fullpath},$fn)) {
                my $F;
-               unless (open($F,'>'.$fn)) {
+               unless (open($F,'>:encoding(utf8)', $fn)) {
                        warn "cannot open \"$fn\": $!";
                        return;
                }
@@ -530,10 +542,13 @@ sub makeaux {
                                        {-src=>$inc."urlparser.js"},
                                        {-src=>$inc."infopage.js"},
                                ]),"\n",
+                       comment("Created by ".$version),"\n",
                        start_center,"\n",
                        h1($title),"\n",
                        table({-class=>'ipage'},
-                               Tr(td(img({-src=>$imgsrc})),
+                               Tr(td(img({-src=>$imgsrc,
+                                          -class=>'thumbnail',
+                                          -alt=>$title})),
                                        td($self->infotable))),
                        a({-href=>'../index.html',-class=>'conceal'},
                                'Index'),"\n",
@@ -549,68 +564,102 @@ sub startindex {
        my $block = $self->{-fullpath}.'/.noindex';
        $fn = '/dev/null' if ( -f $block );
        my $IND;
-       unless (open($IND,'>'.$fn)) {
+       unless (open($IND,'>:encoding(utf8)', $fn)) {
                warn "cannot open $fn: $!";
                return;
        }
-       binmode($IND, ":utf8");
        $self->{-IND} = $IND;
 
-       my $inc = $self->{-inc};
+       my $inc = $self->{-inc}.$incdir.'/';
        my $title = $self->{-title};
-       my $rsslink="";
-       if ($self->{-rss}) {
-               $rsslink=Link({-rel=>'alternate',
-                               -type=>'application/rss+xml',
-                               -title=>'RSS',
-                               -href=>$self->{-rss}});
-       }
+       my $titleimage = $self->{-titleimage};  
        print $IND start_html(-title => $title,
                        -encoding=>"utf-8",
-                       -head=>$rsslink,
-                       -style=>{-src=>$inc."gallery.css"},
+                       -style=>[
+                               {-src=>$inc."gallery.css"},
+                               {-src=>$inc."custom.css"},
+                       ],
                        -script=>[
                                {-src=>$inc."mootools.js"},
                                {-src=>$inc."overlay.js"},
                                {-src=>$inc."urlparser.js"},
                                {-src=>$inc."multibox.js"},
-                               {-src=>$inc."slideshow.js"},
+                               {-src=>$inc."showwin.js"},
+                               {-src=>$inc."controls.js"},
+                               {-src=>$inc."show.js"},
                                {-src=>$inc."gallery.js"},
-                               {-code=>"var incPrefix='$inc';"}
-                       ]),
-               a({-href=>"../index.html"},"UP"),"\n",
-               start_center,"\n",
-               h1($title),"\n",
+                       ]),"\n",
+               comment("Created by ".$version),"\n",
+               start_div({-class => 'indexContainer',
+                               -id => 'indexContainer'}),
                "\n";
+       my $EVL;
+       if (open($EVL, '<:encoding(utf8)', $self->{-toppath}.'/'.$incdir.'/header.pl')) {
+               my $prm;
+               while (<$EVL>) {
+                       $prm .= $_;
+               }
+               close($EVL);
+               %_ = (
+                       -version        => $version,
+                       -depth          => $self->{-depth},
+                       -title          => $title,
+                       -titleimage     => $titleimage,
+                       -path           => $self->{-fullpath},
+                       -breadcrumbs    => "breadcrumbs unimplemented",
+               );
+               print $IND eval $prm,"\n";
+       } else {
+               print STDERR "could not open ",
+                       $self->{-toppath}.'/'.$incdir.'/header.pl',
+                       " ($!), reverting to default header";
+               print $IND a({-href=>"../index.html"},"UP"),"\n";
+               if ($titleimage) {
+                       print $IND img({-src=>$titleimage,
+                                       -class=>'titleimage',
+                                       -alt=>'Title Image'}),"\n";
+               }
+               print $IND h1({-class=>'title'},$title),
+                       br({-clear=>'all'}),"\n";
+       }
 }
 
 sub endindex {
        my $self = shift;
        my $IND = $self->{-IND};
 
-       print $IND end_center,end_html,"\n";
+       print $IND end_div;
+       my $EVL;
+       if (open($EVL, '<:encoding(utf8)', $self->{-toppath}.'/'.$incdir.'/footer.pl')) {
+               my $prm;
+               while (<$EVL>) {
+                       $prm .= $_;
+               }
+               close($EVL);
+               %_ = (
+                       -version        => $version,
+                       -depth          => $self->{-depth},
+                       -title          => $self->{-title},
+                       -titleimage     => $self->{-titleimage},
+                       -breadcrumbs    => "breadcrumbs unimplemented",
+               );
+               print $IND eval $prm,"\n";
+       } else {
+               print STDERR "could not open ",
+                       $self->{-toppath}.'/'.$incdir.'/footer.pl',
+                       " ($!), reverting to default empty footer";
+       }
+       print $IND end_html,"\n";
 
        close($IND) if ($IND);
        undef $self->{-IND};
-       if ($rssobj) {
-               my $rsstitle=sprintf "%s [%d images, %d subalbums]",
-                               $self->{-title},
-                               $self->{-numofimgs},
-                               $self->{-numofsubs};
-               my $rsslink=$rssobj->{'rss'}->channel('link')."index.html";
-               $rssobj->{'rss'}->add_item(
-                       title           => $self->{-title},
-                       link            => $rsslink,
-                       description     => $rsstitle,
-               );
-       }
 }
 
 sub startsublist {
        my $self = shift;
        my $IND = $self->{-IND};
 
-       print $IND h2("Albums"),"\n",start_table,"\n";
+       print $IND h2({-class=>"atitle"},"Albums"),"\n",start_table,"\n";
 }
 
 sub sub_entry {
@@ -637,8 +686,8 @@ sub startimglist {
        my $first = $self->{-firstimg}->{-base};
        my $slideref = sprintf(".html/%s-slide.html",$first);
 
-       print $IND h2("Images ",
-               a({-href=>$slideref,-class=>'showStart',-id=>$first},
+       print $IND h2({-class=>"ititle"},"Images ",
+               a({-href=>$slideref,-class=>'showStart',-rel=>'i'.$first},
                        '&gt; slideshow')),"\n";
 }
 
@@ -656,29 +705,41 @@ sub img_entry {
        $self->{-parent}->{-numofimgs}++;
 
        print $IND a({-name=>$name}),"\n",
-               start_table({-class=>'slide'}),start_Tr,start_td,"\n",
-               div({-class=>'slidetitle',-id=>$name},
+               start_table({-class=>'slide'}),start_Tr,start_td,"\n";
+       print $IND div({-class=>'slidetitle'},
                        "\n ",a({-href=>".html/$name-info.html",
                                -title=>'Image Info: '.$name,
                                -class=>'infoBox'},
                                $title),"\n"),"\n",
-               div({-class=>'slideimage',-id=>$name},
-                       "\n ",a({-href=>".html/$name-static.html",
+               start_div({-class=>'slideimage'});
+       if ($self->{-geoloc}) {
+               my ($la,$lo) = @{$self->{-geoloc}};
+               print $IND a({-href=>"http://maps.google.com/".
+                                               "?q=$la,$lo&ll=$la,$lo",
+                               -title=>"$la,$lo",
+                               -class=>'geoloc'},
+                               div({-class=>'geoloc'},"")),"\n";
+       }
+       print $IND a({-href=>".html/$name-static.html",
                                -title=>$title,
                                -class=>'showImage',
-                               -id=>$name},
-                               img({-src=>$thumb})),"\n"),"\n",
-               start_div({-class=>'varimages',-id=>$name,-name=>$title}),"\n";
+                               -rel=>'i'.$name},
+                               img({-src=>$thumb,
+                                    -class=>'thumbnail',
+                                    -alt=>$title})),"\n",end_div,
+               start_div({-class=>'varimages',-id=>'i'.$name,-title=>$title}),"\n";
        foreach my $sz(@sizes) {
                my $src=$self->{$sz}->{'url'};
                my $w=$self->{$sz}->{'dim'}->[0];
                my $h=$self->{$sz}->{'dim'}->[1];
                print $IND "  ",a({-href=>$src,
                        -class=>"conceal",
+                       -rel=>$w."x".$h,
                        -title=>"Reduced to ".$w."x".$h},
                        $w."x".$h)," \n";
        }
        print $IND "  ",a({-href=>$name,
+                               -rel=>$w."x".$h,
                                -title=>'Original'},$w."x".$h),
                "\n",end_div,"\n",
                end_td,end_Tr,end_table,"\n";