X-Git-Url: http://www.average.org/gitweb/?p=mkgallery.git;a=blobdiff_plain;f=mkgallery.pl;h=7f54b01786aa1ebef323bf1fe7b0ed652d492a82;hp=54adf58c3842d38696be97d2554d9bfa0c2f5452;hb=d104afdbde8eba624eebe78225833016121f7b22;hpb=b267db57b52a5c4e5e55c698e448b1996f281f88 diff --git a/mkgallery.pl b/mkgallery.pl index 54adf58..7f54b01 100755 --- a/mkgallery.pl +++ b/mkgallery.pl @@ -24,19 +24,203 @@ # misrepresented as being the original software. # 3. This notice may not be removed or altered from any source distribution. +package FsObj; + use strict; use Carp; use POSIX qw/getcwd/; use CGI qw/:html *table *center *div/; use Image::Info qw/image_info dim/; +use Term::ReadLine; +use Getopt::Long; + use Image::Magick; -my $ask=1; -my $startdir=getcwd; +my @sizes = (160, 640); + +###################################################################### + +my $debug = 0; +my $asktitle = 0; +my $noasktitle = 0; + +GetOptions('asktitle'=>\$asktitle, + 'noasktitle'=>\$noasktitle, + 'debug'=>\$debug); + +my $term = new Term::ReadLine "Edit Title"; + +FsObj->new(getcwd)->iterate; + +sub new { + my $this = shift; + my $class; + my $self; + if (ref($this)) { + $class = ref($this); + my $parent = $this; + my $name = shift; + my $fullpath = $parent->{-fullpath}.'/'.$name; + $self = { + -parent=>$parent, + -root=>$parent->{-root}, + -base=>$name, + -fullpath=>$fullpath, + -inc=>'../'.$parent->{-inc}, + }; + } else { + $class = $this; + my $root=shift; + $self = { + -root=>$root, + -fullpath=>$root, + -inc=>getinc($root), + }; + } + bless $self, $class; + if ($debug) { + print "new $class:\n"; + foreach my $k(keys %$self) { + print "\t$k\t=\t$self->{$k}\n"; + } + } + return $self; +} + +sub getinc { + my $fullpath=shift; # this is not a method + my $depth=20; # arbitrary max depth + + my $inc=".include"; + while ( ! -d $fullpath."/".$inc ) { + $inc = "../".$inc; + last unless ($depth-- > 0); + } + if ($depth > 0) { + return $inc.'/'; # prefix with trailing slash + } else { + return 'NO-.INCLUDE-IN-PATH/'; # won't work anyway + } +} + +sub iterate { + my $self = shift; + my $fullpath .= $self->{-fullpath}; + print "iterate in dir $fullpath\n" if ($debug); + + my @rdirlist; + my @rimglist; + my $D; + unless (opendir($D,$fullpath)) { + warn "cannot opendir $fullpath: $!"; + return; + } + while (my $de = readdir($D)) { + next if ($de =~ /^\./); + my $child = $self->new($de); + if ($child->isdir) { + push(@rdirlist,$child); + } elsif ($child->isimg) { + push(@rimglist,$child); + } + } + closedir($D); + my @dirlist = sort {$a->{-base} cmp $b->{-base}} @rdirlist; + undef @rdirlist; # inplace sorting would be handy here + my @imglist = sort {$a->{-base} cmp $b->{-base}} @rimglist; + undef @rimglist; # optimize away unsorted versions + +# 1. first of all, fill title for this directory and create hidden subdirs + + $self->initdir; +# 2. iterate through subdirectories to get their titles filled +# before we start writing out subalbum list + + foreach my $dir(@dirlist) { + print "Dir: $dir->{-fullpath}\n" if ($debug); + $dir->iterate; + } + +# 3. start building index.html for the directory +# 4. iterate through subdirectories to build subalbums list +# 5. iterate through images to build cross-links + + foreach my $img(@imglist) { + print "Img: $img->{-fullpath}\n" if ($debug); + } + +# 6. iterate through images to build thumb list and aux html files +# 7. comlplete building index.html for the directory + +} + +sub isdir { + my $self = shift; + return ( -d $self->{-fullpath} ); +} + +sub isimg { + my $self = shift; + my $fullpath = $self->{-fullpath}; + return 0 unless ( -f $fullpath ); + my $info = image_info($fullpath); + if (my $error = $info->{error}) { + if (($error !~ "Unrecognized file format") && + ($error !~ "Can't read head")) { + warn "File \"$fullpath\": $error\n"; + } + return 0; + } + $self->{-isimg} = 1; + $self->{-info} = $info; + return 1; +} + +sub initdir { + my $self = shift; + my $fullpath = $self->{-fullpath}; + for my $subdir(@sizes, 'html') { + my $tdir=sprintf "%s/.%s",$self->{-fullpath},$subdir; + mkdir($tdir,0755) unless ( -d $tdir ); + } + $self->edittitle; +} + +sub edittitle { + my $self = shift; + my $fullpath = $self->{-fullpath}; + my $title; + my $T; + if (open($T,'<'.$fullpath.'/.title')) { + $title = <$T>; + $title =~ s/[\r\n]*$//; + close($T); + } + if ($asktitle || (!$title && !$noasktitle)) { + my $prompt = $self->{-base}; + $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')) { + print $T $title,"\n"; + close($T); + } + } + unless ($title) { + $title=substr($fullpath,length($self->{-root})) + } + $self->{-title}=$title; + print "title in $fullpath is $title\n" if ($debug); +} + +###################################################################### +=cut ###################################################################### -&processdir($startdir); +&processdir(getcwd); sub processdir { my ($start,$dir)=@_;