X-Git-Url: http://www.average.org/gitweb/?p=mkgallery.git;a=blobdiff_plain;f=mkgallery.pl;h=493fd5ac19561622d465a0692d9a66084461cc70;hp=a0cb8eebef6089317ae33056ddfef89ca91737e7;hb=a56e7b4b7a12b446702ab83217f070cd19680a1d;hpb=c1251ffd78703170ddd2fd6e2d14959f64679da0 diff --git a/mkgallery.pl b/mkgallery.pl index a0cb8ee..493fd5a 100755 --- a/mkgallery.pl +++ b/mkgallery.pl @@ -29,29 +29,73 @@ package FsObj; use strict; use Carp; use POSIX qw/getcwd strftime/; -use CGI qw/:html *table *Tr *center *div/; +use CGI qw/:html *table *Tr *center *div *Link/; use Image::Info qw/image_info dim/; use Term::ReadLine; use Getopt::Long; +use Encode; +use encoding 'utf-8'; +binmode(STDOUT, ":utf8"); -use Image::Magick; +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 @sizes = (160, 640); ###################################################################### +my $incpath; +my $rssobj; my $debug = 0; my $asktitle = 0; my $noasktitle = 0; +my $rssfile = ""; + +charset("utf-8"); -GetOptions('asktitle'=>\$asktitle, +unless (GetOptions( + 'help'=>\&help, + 'incpath'=>\$incpath, + 'asktitle'=>\$asktitle, 'noasktitle'=>\$noasktitle, - 'debug'=>\$debug); + '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"; FsObj->new(getcwd)->iterate; +if ($rssobj) { + $rssobj->save($rssfile); +} + +sub help { + + print STDERR <<__END__; +usage: $0 [options] + --help: print help message and exit + --incpath: do not try to find .include diretory 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; +} + sub new { my $this = shift; my $class; @@ -67,6 +111,7 @@ sub new { -base=>$name, -fullpath=>$fullpath, -inc=>'../'.$parent->{-inc}, + -rss=>'../'.$parent->{-rss}, }; } else { $class = $this; @@ -75,6 +120,7 @@ sub new { -root=>$root, -fullpath=>$root, -inc=>getinc($root), + -rss=>getrss($root), }; } bless $self, $class; @@ -91,6 +137,10 @@ sub getinc { my $fullpath=shift; # this is not a method my $depth=20; # arbitrary max depth + if ($incpath) { + return $incpath."/.include"; + } + my $inc=".include"; while ( ! -d $fullpath."/".$inc ) { $inc = "../".$inc; @@ -103,6 +153,28 @@ sub getinc { } } +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); + } + if ($depth > 0) { + $rssobj = new XML::RSS (version=>2); + $rssobj->parsefile($rss); + return $rss; + } else { + print STDERR "There is no $rssfile in this or parent ". + "directories, you must create one with mkgalrss.pl\n"; + exit 1; + } +} + sub iterate { my $self = shift; my $fullpath .= $self->{-fullpath}; @@ -119,11 +191,11 @@ sub iterate { while (my $de = readdir($D)) { next if ($de =~ /^\./); my $child = $self->new($de); + my @stat = stat($child->{-fullpath}); + $youngest = $stat[9] if ($youngest < $stat[9]); if ($child->isdir) { push(@rdirlist,$child); } elsif ($child->isimg) { - my @stat = stat($child->{-fullpath}); - $youngest = $stat[9] if ($youngest < $stat[9]); push(@rimglist,$child); } } @@ -147,12 +219,6 @@ sub iterate { $dir->iterate; } -# no need to go beyond this point if the directory timestamp did not -# change since we built index.html file last time. - - my @istat = stat($self->{-fullpath}.'/index.html'); - return unless ($youngest > $istat[9]); - # 3. iterate through images to build cross-links, my $previmg = undef; @@ -178,6 +244,12 @@ sub iterate { $img->makeaux; } +# no need to go beyond this point if the directory timestamp did not +# change since we built index.html file last time. + + my @istat = stat($self->{-fullpath}.'/index.html'); + return unless ($youngest > $istat[9]); + # 5. start building index.html for the directory $self->startindex; @@ -340,19 +412,23 @@ sub isnewer { sub doscaling { my ($src,$dest,$factor,$w,$h) = @_; # this is not a method - my $im = new Image::Magick; - my $err; - print "doscaling $src -> $dest by $factor\n" if ($debug); - $err = $im->Read($src); - unless ($err) { - $im->Scale(width=>$w*$factor,height=>$h*$factor); - $err=$im->Write($dest); - warn "ImageMagick: write \"$dest\": $err" if ($err); - } else { # fallback to command-line tools - warn "ImageMagick: read \"$src\": $err"; + + my $err=1; + if ($haveimagick) { + my $im = new Image::Magick; + print "doscaling $src -> $dest by $factor\n" if ($debug); + if ($err = $im->Read($src)) { + warn "ImageMagick: read \"$src\": $err"; + } else { + $im->Scale(width=>$w*$factor,height=>$h*$factor); + $err=$im->Write($dest); + warn "ImageMagick: write \"$dest\": $err" if ($err); + } + undef $im; + } + if ($err) { # fallback to command-line tools system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\""); } - undef $im; } sub makeaux { @@ -365,7 +441,7 @@ sub makeaux { my $title = $self->{-info}->{'Comment'}; $title = $name unless ($title); - print "slide: \"$pref\"->\"$name\"->\"$nref\"\n" if ($debug); + print "slide: \"$title\": \"$pref\"->\"$name\"->\"$nref\"\n" if ($debug); # slideshow for my $refresh('static', 'slide') { @@ -398,8 +474,10 @@ sub makeaux { warn "cannot open \"$fn\": $!"; next; } + binmode($F, ":utf8"); if ($refresh eq 'slide') { print $F start_html( + -encoding=>"utf-8", -title=>$title, -bgcolor=>"#808080", -head=>meta({-http_equiv=>'Refresh', @@ -409,6 +487,7 @@ sub makeaux { } else { print $F start_html(-title=>$title, + -encoding=>"utf-8", -bgcolor=>"#808080", -style=>{-src=>$inc."gallery.css"}, ),"\n"; @@ -440,6 +519,7 @@ sub makeaux { } my $imgsrc = sprintf("../.%s/%s",$sizes[0],$name); print $F start_html(-title=>$title, + -encoding=>"utf-8", -style=>{-src=>$inc."gallery.css"},),"\n", start_center,"\n", h1($title),"\n", @@ -463,11 +543,21 @@ sub startindex { warn "cannot open $fn: $!"; return; } + binmode($IND, ":utf8"); $self->{-IND} = $IND; my $inc = $self->{-inc}; my $title = $self->{-title}; + my $rsslink=""; + if ($self->{-rss}) { + $rsslink=Link({-rel=>'alternate', + -type=>'application/rss+xml', + -title=>'RSS', + -href=>$self->{-rss}}); + } print $IND start_html(-title => $title, + -encoding=>"utf-8", + -head=>$rsslink, -style=>{-src=>[$inc."gallery.css", $inc."lightbox.css"]}, -script=>[{-code=>"var incPrefix='$inc';"}, @@ -487,6 +577,21 @@ sub endindex { close($IND) if ($IND); undef $self->{-IND}; + print STDERR "title=",$self->{-title}, + ", numofsubs=",$self->{-numofsubs}, + ", numofimgs=",$self->{-numofimgs},"\n"; + if ($rssobj) { + my $rsstitle=sprintf "%s [%d images, %d subalbums]", + $self->{-title}, + $self->{-numofimgs}, + $self->{-numofsubs}; + my $rsslink=$rssobj->channel('link')."index.html"; + $rssobj->add_item( + title => $self->{-title}, + link => $rsslink, + description => $rsstitle, + ); + } } sub startsublist { @@ -502,6 +607,7 @@ sub sub_entry { my $name = $self->{-base}; my $title = $self->{-title}; + $self->{-parent}->{-numofsubs}++; print $IND Tr(td(a({-href=>$name.'/index.html'},$name)), td(a({-href=>$name.'/index.html'},$title))),"\n"; } @@ -535,6 +641,7 @@ sub img_entry { my $info = $self->{-info}; my ($w, $h) = dim($info); + $self->{-parent}->{-numofimgs}++; print $IND start_div({-class=>'ibox',-id=>$name, -OnClick=>"HideIbox('$name');"}),"\n", start_div({-class=>'iboxtitle'}),