#!/usr/bin/perl -Tw
#
# Gallery.pm Daniel Brockman 070204 A gallery generator.
#
# Permission granted to use with attribution to Daniel
# Brockman under Creative Commons Attribution License.
#################################################
# The author grants permission to use for any   #
# purpose, including copying and modification,  #
# provided the user acknowledges the author by  #
# name. (Creative Commons Attribution License   #
# http://creativecommons.org/licenses/by/2.5/ ) #
# -- Daniel Brockman, author, 20070301          #
#################################################
#
#
# Usage: use Gallery ;
#

package Gallery;

use XML::Parser;
#use XML::Simple;
use Simp;                  # XML::Simple alias
use Data::Dumper;
use Carp;
use CGI
 'param', 'start_html', 'h1', 'header',
 'http_host',
 'body', 'span', 'referer', 'script_name',
 'url',
 'Vars',
; 
  
use strict;


# ----------------------------------------------------------------
#-----------------------------------------------
sub new  {             # instantiate a new Gallery object
  # Usage: $g = Gallery->new( [ key1 => val1 [ , key2 => val2 [ , ... ] ] ] ) ;
  #
  # sub new should be called for instantiation of Gallery objects
  # The keys and values provided are optional, however, the 
  # expected usage is 
  #
  #   $g = Gallery->new( manifest => "mymanifestfile.xml" );
  #
  # which will instantiate the object by reading data and 
  # controlling parameters from the manifest file.
  # 
  # If you desire to establish a mere reference to an otherwise
  # unassigned Gallery object, please use Gallery->spawn().
  #
  # Notes: 
  # 1. some key values are reserved and may not appear in the 
  # argument list of sub new, and they are ...
  #   data
  #   manipulator
  # 2. variable $v controls XML module invocation
  # 
  
  my $class = shift;
  if(@_ % 2) {
    croak "Default options must be name=>value pairs (odd number supplied)";
  }
  my $self = spawn($class);         # instantiate new object
  my %args = @_;                       # pick up args

  my $v ;
  $v = 1;                        # v 1 = XML::Simple
  $v = 2;                        # v 2 = XML::Parse
  $v = 3;                        # v 3 = Simp

  $self->{cgi} = new CGI;              # get CGI object

  while (my($key,$val) = each %args ) {   # loop arguments
    $self->{$key} = $val;              # assign to object
#    print "L18 val:$val\n";            # test
  }  # end loop arguments

  # read data and paramters from manifest

  if ($self->{manifest}) {    # we have some file name?
    if ( -f $self->{manifest} ) {      # file exists?
      
      if ($v == 2) {
        # set up manipulator
        $self->{manipulator} = XML::Parser->new(Style => 'Tree');
  
        print ("Gallery L80 self->{manifest}: $self->{manifest}\n"); # test
        $self->{data} 
          = $self->{manipulator}
              ->parsefile($self->{manifest}); # populate the hash

      } elsif ($v == 1) {             # if v
        $self->{manipulator} = XML::Simple->new();       # set up manipulator
        $self->{data} 
          = $self->{manipulator}
            ->XMLin($self->{manifest}); # populate the hash

      } elsif ($v == 3) {             # if v
        $self->{manipulator} = Simp->new();       # set up manipulator
        $self->{data} 
          = $self->{manipulator}
            ->XMLin($self->{manifest}); # populate the hash
    

      } else {             # if v
        croak "Error: v:$v";
      }             # if v

    }    # if file exists
      else {
        croak "File ".$self->{manifest}." not found";
    }    # if file exists

  }        # if we have some file name

  
  return($self);                 # instantiate new obj.
};

# ----------------------------------------------------------------
sub spawn() { bless({},$_[0]); } # Wall,"Programming Perl,3rd ed.",p.318
# ----------------------------------------------------------------
sub gtest() {          # test our ability to read the hash

  # Usage: $g->gtest();
  #
  # Note on interpreting result of XML::Parser...
  # http://search.cpan.org/~msergeant/XML-Parser-2.34/Parser.pm#Tree
  my $self = shift;    # pick up reference

  my (
    $i, $j, $k, $L, $m, $n, $o, $p,        # iterators
    $ii, $jj, $kk,     # aux
    %i, %j, %k,        # aux hashes
    @i, @j, @k,        # aux arrays
    $x, $y, $z,        # aux
  ); 

  

  print ("L46:  gtest() ---------------------------------------------\n");
  print Dumper($self);#->{data});


  print ("L139: gtest() ---------------------------------------------\n");

    &ahsdep("Gallery",$self) ;           # what have we here?

  
  print ("L144:  gtest() ---------------------------------------------\n");

    foreach $i ( keys %$self ) {

      $x=$self->{$i};

      if ($i eq "manifest") {
        print "manifest = ".$x."\n";

      } elsif ($i eq "manipulator") {
        print "manipulator = ".$x."\n";

      } elsif ($i eq "data") {

        if ("ARRAY" eq ref($x)) {                      # BBB

          for ($j=0;$j<@{$x};$j++) {
            my $y=$$x[$j];
            print "data = [$j] = $y\n";
  
            if ($j == 1 ) {
              my $yy ;
              for ($k=0;$k<@{$y};$k++) {
              }
  
            }   # if j == 1
  
          }  # for j

        }elsif ("SCALAR" eq ref($x)) {                      # BBB

          print "data => $x\n";

        }else {       # HASH and Object                      # BBB

          print "\( data: ".ref($x)." x:$x \)\n";

        }                      # BBB

      } else {
        print "i:$i x:$x\n";
      }   # if i

    }  # foreach $i
      

  print ("L158:  gtest() ---------------------------------------------\n");
  


} # end gtest()
#-----------------------------------------------------------------
sub ahsdep() {              # array, hash, scalar depictor
  # usage: $x = &ahsdep("",<something>)
  #   ahsdep will print the contents of <something>, 
  #     hopefully with more readability than data dumper
   
  my (
    $s,
    $ahs
  ) = @_ ;    # arg

  my (
    $r,                     # value returned from ref();
    $i, $j, $k,             # aux
  );

  $r = ref($ahs);           # get the type of thing

  if ($r) {                 # outer if r: isn't a scalar?

    if ($r eq "ARRAY") {

      for ($i=0;$i<@$ahs;$i++) {
        $j=$s."[".$i."]" ;                  # the string
        &ahsdep($j,$ahs->[$i]) ;            # recurse
        $j=$s;                              # restore
      }  # for i

    } elsif (
        ($r eq "HASH") or 
        ($r eq "Gallery")
            ) {

      foreach $i (keys %$ahs) {
        $j=$s."{".$i."}" ;                # the string
        &ahsdep($j,$ahs->{$i}) ;            # recurse
        $j=$s;                              # restore
      }  # for i

    } else {                 # neither array nor hash, but some kind of ref
      print "$s\=$r|\n";       # just show the descrip
    
    }  # if r

  } else {                   # outer if r: is scalar?

    print "$s:$ahs|\n";       # print the value

  } # outer if r

} # end sub ahsdep

      


# ----------------------------------------------------------------
sub whtml() {             # Write HTML gallery page
  # usage: $g->whtml( [ { page => p } ] ) ;
  #   where p is an integer number >= 1 of a page
  #   or p is "last"
  #

  #print "Gallery L149: \@\_:@_ \n";

  my $self = shift;       # pick up the object
  my %arg = @_;           # pick up args
  my $page = $arg{page};        # pick up page number from arg list
  my $dir = $self->{data}->{d}->{name};       # dir containing the images
  my @pg = @{$self->{data}->{d}->{f}} ;       # the images
  my @rail = @{$self->{data}->{fence}->{i}} ; # the fence rails
  my $last = @pg ;        # count of items in list
   
  my ($key,$val) = each(%arg);
#  print "Gallery L157: key:$key, val:$val \$arg\{page\}:$arg{page}\n";
#  print "Gallery L158: page:$page last:$last\n";

  my (
    %param,              # parameter keys from url

  );

  %param = Vars;         # get parameter values into a hash
                         # assuming none of the legal ones
                         # are multivalued. 
                         # See http://perldoc.perl.org/CGI.html

  if ($param{page}) {    # page specified in url?
    $page=$param{page};  # override any prior value
  }

  # check page number is in bounds
  if ($page =~ m/last/i ) {   # value is "last" (case-insensitive)?
    $page = $last ;           # count of items
  } elsif ($page =~ m/\D/ ) { # page contains nondigits
    $page = 1 ;
  } elsif ($page > $last ) {  # beyond end
    $page = $last ;           # limit to last item
  } elsif ($page < 1     ) {  # before beginning?
    $page = 1 ;               # limit to 1st item
  }

  #print "Gallery L176: page:$page last:$last\n";

  # titles, logos, topbanners, etc
  $self->pagtop();     
  
  # horizontal page nav
  print "<br><center>\n";     # we want it centered should this be in pagnav()?
  $self->pagnav($page,$dir,\@pg);
  print "</center>\n";

  # image display
  $self->payload($dir,$pg[$page-1]);
  
  # horizontal page nav
  print "<br><center>\n";     # we want it centered
  $self->pagnav($page,$dir,\@pg);
  print "</center>\n";

  # fence
  print "<br><center>\n";     # we want it centered
  $self->fence(\@rail);       # display the fence
  print "</center>\n";

  # page bottom, bottombanners, etc
  $self->pagbot();

} # end whtml

# ----------------------------------------------------------------
sub pagtop {               # page initialization
  my $self = shift;                      # collect identity
  my $css = $self->{data}->{css};        # css file to use
  my $title = $self->{data}->{title};    # window

  
  print header() ;                         # http header

  print start_html(                      # html headers and body init
    -title=>$title,
    -style=>{'src'=>$css},         
  );
} # end pagtop 
# ----------------------------------------------------------------
sub pagnav {
  # Usage: $self->pagnav($page,$dir,\@pg);
  #   where $page is the page to display
  #         $dir is the dir containing the images
  #         \@pg refers to the array of image names

  my (
    $self, $page, $dir, $rpg, 
  ) = @_;                         # args

  my @pg=@$rpg;                   # deref arg

  # index to page in array
  my $pick = $page - 1;
  my $last = @pg;                 # number of pages

  my (
    @dpg,                         # numbers of the links we will display
    $i, $j, $k,                   # utility
    $uxp,                         # url ex page num
  );

  $dir=$self->dirfix($dir);       # check and adjust dir name

  $uxp=url();                 # url excluding page num parm

  # assign @dpg
  # $dpg[0] is meaningless to us
  $dpg[1]=1;                      # the first page
  $dpg[2]=$page-1;                # the previous page
  $dpg[3]=int(($page+1)/2);       # half way from our page to the 1st
  $dpg[4]=$page-2;                # 2nd page previous
  $dpg[5]=$page-1;                # the previous page
  $dpg[6]=$page;                  # the page we will display
  $dpg[7]=$page+1;                # the next page
  $dpg[8]=$page+2;                # the page after that
  $dpg[9]=int(($page+$last+1)/2); # half way from our page to the end
  $dpg[10]=$page+1;               # the next page
  $dpg[11]=$last;                 # the last page
  
  # print the link for each of these 11 cases

  print "<span id=\"pagnav\">\n";
  print "<font class=\"sm1\">\n";
  
  # link to first page
  if ($dpg[1]<$dpg[6]) {            # our page differs from first ?
    $k=""
      ."<a href=$uxp?page="
      .$dpg[1]       # target
      .">"
      ."1 (First)"
      ."</a>" ; 

    print " $k\n";
  }

  # link to prev page
  if (($dpg[1]<=$dpg[2]) and ($dpg[2]<$dpg[6])) {   # prev page might be 1st,
                                                    # and our page not first?
    $k="&nbsp;&nbsp;"
      ."<a href=$uxp?page="
      .$dpg[2]       # target
      ."><b><font class=\"lg0\">"
      ."<< Prev"
      ."</font></b></a>" ; 

    print " $k\n";
  }

  # link to long jump page
  if (($dpg[1]+1<$dpg[3]) and 
      ($dpg[3]+1<$dpg[4])) {                       # long jump page isn't first
                                                   # and our page is several 
                                                   # from the long jump
    $k="&nbsp;&nbsp;"
      ."..."
      ."&nbsp;"
      ."<a href=$uxp?page="
      .$dpg[3]       # target
      .">"
      .$dpg[3]
      ."</a>" 
      ."&nbsp;"
      ."..."
      ."&nbsp;&nbsp;" ;

    print " $k\n";
  }

  # first of five centered on our page
  if (($dpg[1]<$dpg[4]) ) {                 # not first?
    $k="&nbsp;&nbsp;"
      ."<a href=$uxp?page="
      .$dpg[4]       # target
      .">"
      .$dpg[4]
      ."</a>" ;

    print " $k\n";
  }

  # second of five centered on our page
  if (($dpg[1]<$dpg[5])) {                  # not first?
    if (($dpg[1]>=$dpg[4]) ) {              # didn't print a special space?
      print "&nbsp;&nbsp;" ;                      # then print one
    }
    $k=""
      ."<a href=$uxp?page="
      .$dpg[5]       # target
      .">"
      .$dpg[5]
      ."</a>" ;

    print " $k\n";
  }

  # we always print our page
  {   
    if (($dpg[1]>=$dpg[5]) ) {              # didn't print a special space?
      print "&nbsp;&nbsp;" ;                      # then print one
    }
    $k=       # it's not a link
       "<b><font class=\"lg0\">"
      .$dpg[6]
      ."</font></b>" ;

    print " $k";
    if (($dpg[11]<=$dpg[7]) ) {             # not gonna print a special space?
      print "&nbsp;&nbsp;" ;                      # then print one
    }
    print "\n";
  }

  # fourth of five centered on our page
  if (($dpg[7]<$dpg[11])) {                 # not last?
    $k=""
      ."<a href=$uxp?page="
      .$dpg[7]       # target
      .">"
      .$dpg[7]
      ."</a>" ;

    print " $k";
    if (($dpg[11]<=$dpg[8]) ) {             # not gonna print a special space?
      print "&nbsp;&nbsp;" ;                      # then print one
    }
    print "\n";
  }

  # fifth of five centered on our page
  if (($dpg[8]<$dpg[11]) ) {                 # not last?
    $k=""
      ."<a href=$uxp?page="
      .$dpg[8]       # target
      .">"
      .$dpg[8]
      ."</a>"
      ."&nbsp;&nbsp;" ;

    print " $k\n";
  }

  # link to long jump page
  if (($dpg[11]>$dpg[9]+1) and 
      ($dpg[9]>$dpg[8]+1))                      {  # long jump page isn't last
                                                   # and our page is several 
                                                   # from the long jump
    $k="&nbsp;&nbsp;"
      ."..."
      ."&nbsp;"
      ."<a href=$uxp?page="
      .$dpg[9]       # target
      .">"
      .$dpg[9]
      ."</a>" 
      ."&nbsp;"
      ."..."
      ."&nbsp;&nbsp;" ;

    print " $k\n";
  }

  # link to next page
  if (($dpg[11]>=$dpg[10]) and ($dpg[10]>$dpg[6])) {  # next page might be last,
                                                      # and our page not last?
    $k=""
      ."<a href=$uxp?page="
      .$dpg[10]       # target
      ."><b><font class=\"lg0\">"
      ."Next >>"
      ."</font></b></a>" 
      ."&nbsp;&nbsp;" ;

    print " $k\n";
  }
  
  # link to last page
  if ($dpg[11]>$dpg[6]) {            # our page differs from last ?
    $k=""
      ."<a href=$uxp?page="
      .$dpg[11]       # target
      .">"
      .$last." (Last)"
      ."</a>" ; 

    print " $k\n";
  }

  print "</font>\n";
  print "</span>\n";

} # sub pagnav
# ----------------------------------------------------------------
sub payload() {              # display main content of one page

  #print "<p><h1>Stub sub payload()</h1>\n";  # test

  my (
    $self, 
    $dir,                 # dir containing file
    $fil,                 # file containing image
  ) = @_;                         # args

    $dir=dirfix($dir);    # check and adjust dir name

    print "<center>";
    print "<br>";
    print "<a href=".$dir.$fil   
      ."><img src=".$dir.$fil
      ." border=0></a>\n" ; 
    print "<br>";
    print "</center>";

}
# ----------------------------------------------------------------
sub fence() {
  my $self = shift ;
  my ( 
    $rrail,            # ref to fence rails
  ) = @_;
# test  print "<p><h1>Stub sub fence()</h1>\n";

  my @rail=@$rrail;    # easier to work with

  my ( %h, $i, $j, $k,     # aux
    $s,                # rail words
    $t,                # link target
  );

  print "<br><font class=\"sm1\">\n";

  for ($i=0;$i<@rail;$i++) {           # loop the fence rails
    %h=%{$rail[$i]};
    $s=$h{slug};
    $t=$h{targ};
    print "<a href=$t>$s</a>";
    if ($i!=$#rail) {
      print " |\n";
    }
  }  # end for i

  print "</font>\n";

}
# ----------------------------------------------------------------
sub pagbot() {
  # print "<p><h1>Stub sub pagbot()</h1>\n";
}
# ----------------------------------------------------------------

sub dirfix(){       # check and adjust dir name
  my $self = shift;          # object ref
  my (
    $dir,           # 
  ) = @_ ;

  if (!$dir) {                    # we got no dir name?
    $dir="";                      # assign null string
  } else {
    $dir=$dir."/";                # append a slash
    $dir =~ s/\/\//\//g ;         # remove double slash if we have one
  }
  return($dir);
}  # end sub dirfix
# ----------------------------------------------------------------
1