X-Git-Url: http://www.average.org/gitweb/?p=mkgallery.git;a=blobdiff_plain;f=mkgallery.pl;h=21eccb5d8583aeb55a7c31a570f2d8eecebe5834;hp=40840b76e1425b639b8412ea592c7a5bf475acb9;hb=570392910b2d342d674bf49b7592c9342b3bf44f;hpb=035a5d0ef46b005f32ffacaba9ae660f9540fed5 diff --git a/mkgallery.pl b/mkgallery.pl index 40840b7..21eccb5 100755 --- a/mkgallery.pl +++ b/mkgallery.pl @@ -29,20 +29,27 @@ 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 encoding 'utf-8'; binmode(STDOUT, ":utf8"); my $haveimagick = eval { require Image::Magick; }; { package Image::Magick; } # to make perl compiler happy -my $haverssxml = eval { require XML::RSS; }; +my $haverss = eval { require XML::RSS; }; { package XML::RSS; } # to make perl compiler happy +my $haveatom = eval { require XML::Atom; }; +{ package XML::Atom; } # 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"; @@ -53,7 +60,7 @@ my $rssobj; my $debug = 0; my $asktitle = 0; my $noasktitle = 0; -my $rssfile = ""; +my $feed = ""; charset("utf-8"); @@ -62,13 +69,13 @@ unless (GetOptions( 'incpath'=>\$incpath, 'asktitle'=>\$asktitle, 'noasktitle'=>\$noasktitle, - 'rssfile=s'=>\$rssfile, + 'feed=s'=>\$feed, 'debug'=>\$debug)) { &help; } -if ($rssfile && ! $haverssxml) { - print STDERR "You need to get XML::RSS from CPAN to use --rssfile\n"; +if ($feed && ! ($haverss || $haveatom)) { + print STDERR "You need to get XML::RSS and/or XML::Atom to use --feed\n"; exit 1; } @@ -82,13 +89,13 @@ 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 + --feed=...: build RSS feed for newly added "albums", give name of rss file __END__ exit 1; @@ -109,14 +116,13 @@ sub new { -depth=>$parent->{-depth}+1, -base=>$name, -fullpath=>$parent->{-fullpath}.'/'.$name, - -relpath=>$parent->{-relpath}.'/'.$name, + -relpath=>$parent->{-relpath}.$name.'/', -inc=>'../'.$parent->{-inc}, }; } else { $class = $this; my $root=shift; $self = { - -depth=>0, -root=>$root, -fullpath=>$root, }; @@ -158,12 +164,14 @@ sub initpaths { $pos=index($inc,'/',$pos+1)) { $dp++; } + $self->{-depth} = $dp; for ($pos=length($fullpath);$dp>0 && $pos>0; $pos=rindex($fullpath,'/',$pos-1)) { $dp--; } 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"; @@ -172,42 +180,38 @@ sub initpaths { $self->{-inc} = 'NO-.INCLUDE-IN-PATH/'; # won't work anyway $self->{-rss} = ''; $self->{-relpath} = ''; + $self->{-depth} = 0; } } sub initrss { my $self=shift; # this is not a method but we cheat my $fullpath=$self->{-fullpath}; + my $toppath=$self->{-toppath}; my $inc=$self->{-inc}.$incdir.'/'; - my $conffile=$inc.'rss.conf'; + my $conffile=$toppath.'/'.$incdir.'/feed.conf'; my $CONF; - if ($rssfile) { - if (open($CONF,">".$conffile)) { - print $CONF "file: ",$rssfile,"\n"; - close($CONF); + if (! $incpath) { + if ($feed) { + if (open($CONF,">".$conffile)) { + print $CONF $feed,"\n"; + close($CONF); + } else { + print STDERR "could not open $conffile: $!\n"; + } } else { - print STDERR "could not open $conffile: $!\n"; - } - } else { - if (open($CONF,$conffile)) { - my $ln=<$CONF>; - close($CONF); - chop $ln; - my ($k,$v)=split(':', $ln); - $k =~ s/^\s*//; - $k =~ s/\s*$//; - $v =~ s/^\s*//; - $v =~ s/\s*$//; - if ($k eq 'file') { - $rssfile=$v; + if (open($CONF,$conffile)) { + $feed=<$CONF>; + close($CONF); + chop $feed; } } } - return unless ($rssfile); + return unless ($feed); - $rssobj->{'file'} = $self->{-toppath}.'/'.$rssfile; + $rssobj->{'file'} = $self->{-toppath}.'/'.$feed; $rssobj->{'rss'} = new XML::RSS (version=>'2.0'); if ( -f $rssobj->{'file'} ) { $rssobj->{'rss'}->parsefile($rssobj->{'file'}); @@ -217,9 +221,16 @@ sub initrss { } $rssobj->{'rss'}->save($rssobj->{'file'}); } else { - my $link=""; - for (my $pos=index($rssfile,'/');$pos>=0; - $pos=index($rssfile,'/',$pos+1)) { + my $link; + my $p1; + my $p2; + for ($p1=0,$p2=length($toppath); + substr($feed,$p1,3) eq '../' && $p2>0; + $p1+=3,$p2=rindex($toppath,'/',$p2-1)) {;} + $link=substr($toppath,$p2); + $link =~ s%^/%%; + $link .= '/' if ($link); + while (($p1=index($feed,'/',$p1+1)) >= 0) { $link = '../'.$link; } @@ -355,6 +366,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") && @@ -422,6 +443,7 @@ sub edittitle { my $title; my $T; if (open($T,'<'.$fullpath.'/.title')) { + binmode($T, ":utf8"); $title = <$T>; $title =~ s/[\r\n]*$//; close($T); @@ -588,6 +610,7 @@ sub makeaux { warn "cannot open \"$fn\": $!"; return; } + binmode($F, ":utf8"); my $imgsrc = sprintf("../.%s/%s",$sizes[0],$name); print $F start_html(-title=>$title, -encoding=>"utf-8", @@ -629,11 +652,11 @@ sub startindex { my $inc = $self->{-inc}.$incdir.'/'; my $title = $self->{-title}; my $rsslink=""; - if ($self->{-rss}) { + if ($rssobj) { $rsslink=Link({-rel=>'alternate', -type=>'application/rss+xml', -title=>'RSS', - -href=>$self->{-rss}}); + -href=>$self->{-inc}.$feed}); } print $IND start_html(-title => $title, -encoding=>"utf-8", @@ -657,7 +680,7 @@ sub startindex { -id => 'indexContainer'}), "\n"; my $EVL; - if (open($EVL,$inc.'header.pl')) { + if (open($EVL,$self->{-toppath}.'/'.$incdir.'/header.pl')) { my $prm; while (<$EVL>) { $prm .= $_; @@ -667,10 +690,14 @@ sub startindex { -version => $version, -depth => $self->{-depth}, -title => $title, + -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", h1({-class=>'title'},$title),"\n", } @@ -682,7 +709,7 @@ sub endindex { print $IND end_div; my $EVL; - if (open($EVL,$self->{-inc}.$incdir.'/footer.pl')) { + if (open($EVL,$self->{-toppath}.'/'.$incdir.'/footer.pl')) { my $prm; while (<$EVL>) { $prm .= $_; @@ -695,6 +722,10 @@ sub endindex { -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"; @@ -706,11 +737,12 @@ sub endindex { $self->{-numofimgs}, $self->{-numofsubs}; my $rsslink=$rssobj->{'rss'}->channel('link'). - $self->{-relpath}."/index.html"; + $self->{-relpath}."index.html"; $rssobj->{'rss'}->add_item( title => $self->{-title}, link => $rsslink, description => $rsstitle, + pubDate => time2str(time), ); } } @@ -765,20 +797,28 @@ sub img_entry { $self->{-parent}->{-numofimgs}++; print $IND a({-name=>$name}),"\n", - start_table({-class=>'slide'}),start_Tr,start_td,"\n", - div({-class=>'slidetitle'}, + 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'}, - "\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', -rel=>'i'.$name}, img({-src=>$thumb, -class=>'thumbnail', - -alt=>$title})),"\n"),"\n", + -alt=>$title})),"\n",end_div, start_div({-class=>'varimages',-id=>'i'.$name,-title=>$title}),"\n"; foreach my $sz(@sizes) { my $src=$self->{$sz}->{'url'};