#!/usr/bin/perl -w package Gallery; use strict; use warnings; use mmHTMLGen; use TreeMenu; use Carp; sub new { my $class = shift; my $this = {}; $this->{ 'htops' } = { 'lang' => 'cs', 'charset' => 'iso-8859-2', 'title' => 'Gallery contents', 'author' => 'Martin Matousek', 'css' => 'top.css', 'rawhead' => "\n", }; $this = bless( $this, ref( $class ) || $class ); return $this; } sub ScalarChildren { my $this = shift; my $Tree = shift; return [ 'files' => $Tree->{'children'} ]; } sub Contents { my $this = shift; my $seltx = shift; my $galfile = shift; my $args = shift; my @sel = split( '/', $seltx ); HTMLPrintHead(%{$this->{'htops'}}); print ""; $this->{'args'} = $args; my $tree = do( $galfile ) or croak "Read of $galfile not successful ($@)"; $tree = new TreeMenu( $tree, $this ); $tree->Process( \@sel ); $this->Options( $args ); print "\n\n"; } sub ChildArray { my $this = shift; my $tree = shift; return { 'title' => $tree->[0], 'children' => "$tree->[1]/*.jpg" }; } sub Options { my $this = shift; my $args = $this->{'args'}; # options tn, full print "

\n"; my %nargs; %nargs = %{$args}; $nargs{'tn'} = !$nargs{'tn'}; print( "MenuHref($args->{'lastnode'}, \%nargs) . "\" target=\"_self\">[" . ( $nargs{'tn'} ? 'thumbs' : 'no thumbs' ) . "]" ); %nargs = %{$args}; $nargs{'full'} = !$nargs{'full'}; print( "MenuHref($args->{'lastnode'}, \%nargs) . "\" target=\"_self\">[" . ( $nargs{'full'} ? 'full size' : 'normal size' ) . "]" ); if( defined( $args->{'back'} ) ) { print "
{'back'}\" target=\"_parent\">[back]\n"; } } sub Node { my $this = shift; my $tree = shift; my $opts = $this->{'args'}; # print STDERR ref( $this ), "<<\n"; print( ( ' ' x ( $tree->{'level'} ) ) . "MenuHref($tree, $opts) . "\" target=\"_self\">" . "

" . "$tree->{'title'}
\n" ); $opts->{'lastnode'} = $tree; if( $opts->{'tn'} ) { exists( $tree->{'tnpre'} ) and $opts->{'tnpre'} = $tree->{'tnpre'}; exists( $tree->{'tnpost'} ) and $opts->{'tnpost'} = $tree->{'tnpost'}; } if( $opts->{'full'} ) { exists( $tree->{'fullpre'} ) and $opts->{'pre'} = $tree->{'fullpre'}; exists( $tree->{'fullpost'} ) and $opts->{'post'} = $tree->{'fullpost'}; } } sub Leaf { my $this = shift; my $tree = shift; my $opts = $this->{'args'}; print( ( ' ' x ( $tree->{'level'} ) ) . "MenuHref($tree, $opts) . "\" target=\"_self\">" . "

" . "$tree->{'title'}
\n" ); } sub text { my $this = shift; print "

$_[0]

\n"; } sub head { my $this = shift; print "

$_[0]

\n"; } sub files { my $this = shift; my $files = shift; my $tree = shift; my $opts = $this->{'args'}; local *GFFILE; my $path = $tree->{'path'}; if( ref( $files ) ) # pairs 'name' - 'filename' { } else { ($path, $files) = Repath( $path, $files ); open GFFILE, "find $path -maxdepth 1 -iname \"$files\" | sort |"; if( !eof( GFFILE ) ) { while( ) { chomp; Image( $_, $opts ); } } close GFFILE; } } sub Repath { my ($path, $file) = @_; $file =~ /\/([^\/]+)$/ and do { $path .= $` . '/'; $file = $1; }; return ($path, $file ); } sub Image { my $image = shift; my $opts = shift; $image =~ /([^\/]*)(\.[^\.]+)$/; my $name = $1; my $pre = $`; my $suf = $2; $image = "\"" . $pre . ( $opts->{ 'pre' } || '' ) . $name . ( $opts->{ 'post' } || '' ) . $suf . "\""; if( $opts->{ 'tnpre' } || $opts->{ 'tnpost' } ) { my $tn = "\"" . $pre . ( $opts->{ 'tnpre' } || '' ) . $name . ( $opts->{ 'tnpost' } || '' ) . $suf . "\""; printf " " . "

\n"; printf " " . "$name

\n"; } else { printf " " . "$name
\n"; } } sub StartLeaves{} sub EndLeaves{} 1;