package PhotoPub::Handlers;
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(&installhandler &handlephoto &listhandlephoto &forallhandlers
		&parameterhandlephoto &listparameterhandlephoto
                &loadingconfig &unloadconfig
		&counthandlers);

use PhotoPub::Global qw(&register_init $error);

my %handlers;
# cache to indicate whether a path has had dynamicloader run on it
my %dynamicloaded; 

# recursion detection
my %handling;

#   **Warning**
# Our debug level must be less than or equal to that of our calling 
# script, or problems (eg output before headers etc) will occur
my $debug = 0;

# should rename handlephoto/listhandlephoto to handlename/listhandlename
my @handlertypes=('dynamicloader'
		 ,'imagefile'         # handlephoto
		 ,'existsphotos'      # listparameterhandlephoto
		 ,'photolist'         # listhandlephoto
		 ,'enumsubpaths'      # forallhandlers
		 ,'cachefileprefix'   # handlephoto
		 ,'exifcachefile'     # handlephoto
		 ,'sizecachefile'     # handlephoto
		 ,'photogroups'       # forallhandlers
		 ,'forcemogrify'      # handlephoto
		 ,'pagetemplate'      # handlephoto
		 ,'embedtemplate'     # handlephoto
		 ,'rangetemplate'     # handlephoto
		 ,'albumtemplate'     # handlephoto
#		 ,'annotations'       # handlephoto
                 ,'description'       # handlephoto
                 ,'options'           # handlephoto
		 ,'album'             # listhandlephoto
		 ,'albumtitle'        # handlephoto
		 ,'albumstyle'        # handlephoto
		 ,'rangeinfo'         # parameterhandlephoto
                 ,'whentaken'         # handlephoto
		 ,'canonicalname'     # handlephoto
		 ,'test'              # handlephoto
		 ,'default'           # handlephoto
                 ,'linkroot'          # handlephoto
		 ,'parallellimit'     # handlephoto
                 );

&register_init('startup',sub {
                 %dynamicloaded=();
		 %handling=();
	       });

foreach my $type (@handlertypes) {
  $handlers{$type}={};
}

sub walkhandlers_dynamicloader {
  my ($components)=@_;

  my $limit=scalar(@$components);
  my $i=0;
  my ($finished,$loop);
  
  while($i<=$limit) {
    my $path=&makepathstring(@$components[0..($i-1)]);
    if(exists $handlers{'dynamicloader'}->{$path}) {
      my $again;
      do {
	$again=0;
	foreach my $handler (@{$handlers{'dynamicloader'}->{$path}}) {
	  my $val=&lexicalconfig($handler->{'config'},sub {
	     $handler->{'sub'}->(join('/',@$components[$i..$#$components]))
	   });
	  if(defined $val && $val) {
	    $again=1; last;
	  }
	}
      } while($again);
    }
    $i++;
  }
}

sub walkhandlers_downwards {
  my ($type,$components,$sub)=@_;

  my $i=scalar(@$components);
  
  while($i>=0) {
    my $path=&makepathstring(@$components[0..($i-1)]);

    if(exists $handlers{$type}->{$path}) {
      foreach my $handler (@{$handlers{$type}->{$path}}) {
	my $val=$handler->{'sub'}->(join('/',@$components[$i..$#$components]));
	if(defined $val) {
	  return if $sub->($val);
	}
      }
    }
    $i--;
  }
}


sub walkhandlers {
  my ($type,$photo,$sub)=@_;

  &$error(type => 'internal',
	  message => "Photo not defined in $type call to walkhandlers")
    unless defined $photo;

  my $handlestring="$type:$photo";
  $handling{$handlestring}++;
  &$error(type => 'internal', 
	  message => "Infinite recursion handling $handlestring")
    if $handling{$handlestring}>2;

  # print STDERR "handle $type $photo\n";
  if( $debug >= 2 ) {
    print "Walking handlers: \$type=$type \$photo=$photo \$sub=$sub\n";
  }

  my $handlers=$handlers{$type}
    or &$error(type => 'internal',
	       message => "Unknown handler type $type");

  # if the call is for "/banana/", we want the trailing null field so that
  # the dynamic loading logic below works correctly, so LIMIT parameter to
  # split is -1 to achive this
  my @components=split('/',$photo,-1); 
  shift @components; # Remove effect of leading /

  my $size=scalar @components;
  my @path=@components[0..($size-2)];
  my $path=&makepathstring(@path);
  if(not exists $dynamicloaded{$path}) { 
    &walkhandlers_dynamicloader(\@path);
    $dynamicloaded{$path}=1;
  }
  &walkhandlers_downwards($type,\@components,$sub);

  $handling{$handlestring}--;
}

my $loadingconfig='';
my %configdeps=();

sub loadingconfig {
  my ($name,$sub)=@_;
#  print "loading config $name in $loadingconfig\n";
  push @{$configdeps{$loadingconfig}},$name;
  &lexicalconfig($name,$sub);
#  print "done $name\n";
}

sub lexicalconfig {
  my ($name,$sub)=@_;
  my $oldconfig=$loadingconfig;
  $loadingconfig=$name;
  my $ret=&$sub();
  $loadingconfig=$oldconfig;
  return $ret;
}

sub installhandler {
  my ($type,$path,$sub)=@_;
  defined $handlers{$type} 
    or &$error('type' => 'internal',
	       'message'
                 => "Attempt to register an unknown handler type $type");
  $handlers{$type}->{$path}=[] unless exists $handlers{$type}->{$path};
  # Hmm. Do we really want things this way round? It makes album links and
  # other things where multiple handlers are installed at the same point
  # come out in the right order, but it stops later config files overriding
  # earlier ones.
  push(@{$handlers{$type}->{$path}},{'sub' => $sub,
				     'config' => $loadingconfig});
  if( $debug >= 2) {
    print "Installed handler: $type $path $loadingconfig\n";
  }
}

sub unloadconfig {
  my ($name)=@_;
  foreach my $config (@{$configdeps{$name}}) {
    &unloadconfig($config);
  }
#  print "unloading $name\n";
  while(my ($type,$hash)=each %handlers) {
    foreach my $path (keys %$hash) {
      my @newarray=();
      foreach my $handler (@{$hash->{$path}}) {
	push @newarray,$handler unless $handler->{'config'} eq $name;
      }
      $hash->{$path}=\@newarray;
    }
  }
  delete $configdeps{$name};
}


sub makepathstring {
  my $ret='';
  foreach my $component (@_) {
    $ret.='/'.$component;
  }
  return $ret;
}

# Assumes a type whose handler takes one parameter, which is a photo 
# subpath, and return a scalar. Tries each relevant handler in turn, 
# from most specific to least specific, passing the residual path to each, 
# until one not returning undef is found. Otherwise, returns undef.
sub handlephoto {
  my $ret;
  &walkhandlers(@_,sub {
		  ($ret)=@_;
		  return 1;
		});
  return $ret;
}

# Assumes a type whose handler takes a photo subpath and returns an array
# reference. Iterates over all handlers for the given photo path, most 
# specific to least specific, and sticks all the arrays together, returning
# an array reference too.

sub listhandlephoto {
  my $ret=[];
  &walkhandlers(@_,sub {
		  my ($a)=@_;
		  push @$ret,@$a;
		  return 0;
		});
  return $ret;
}

# Assumes a type whose handler returns a subroutine that expects one more
# parameter. Iterates over all handlers for the given photo path, passing
# in the parameter to the subroutine returned, until a defined value is
# returned; then returns that.

sub parameterhandlephoto {
  my ($type,$photo,$param)=@_;
  my $ret;
  &walkhandlers($type,$photo,sub {
		  my ($sub)=@_;
		  $ret=$sub->($param);
		  return (defined $ret);
		});
  return $ret;
}

# Assumes a type whose handler returns a subroutine that expects one more
# parameter. Iterates over all handlers for the given photo path, passing
# in the parameter to the subroutine returned, and accumulates the lists
# returned.

sub listparameterhandlephoto {
  my ($type,$photo,$param)=@_;
  my $ret=[];
  &walkhandlers($type,$photo,sub {
		  my ($sub)=@_;
		  push @$ret,@{$sub->($param)};
		  return 0;
		});
  return $ret;
}

# Assumes a type whose handler takes no parameters.
# Iterates over all handlers for that type, and for each calls the provided 
# subroutine with the path corresponding to the handler and the result of 
# calling the handler for that path.

# The pathrestrict parameter is used to restrict the paths whose
# corresponding handler is called. Incompatible paths are not called
# at all; thus if pathrestrict is '/ganesh' then the handler for '/stephen'
# won't be called. However, *both* less specific and more specific paths are
# called, thus the root handler and the handler for '/ganesh/foo' will be
# called (if they exist). 
# In the former case, the handler will be passed the "residual"
# path, thus the root handler will be passed 'ganesh/'. In the latter case,
# an empty path will be passed.

# The rationale for this is that we want to enumerate all handlers pertaining
# to the path given. Clearly anything under '/ganesh' will be relevant, but
# a higher-up handler such as the root handler might also have some useful
# information about the path and so should be given the opportunity to provide
# it.

sub forallhandlers {
  my ($type,$pathrestrict,$subtorun)=@_;
  &$error("Unknown handler type $type") unless defined $handlers{$type};

  my @components=split('/',$pathrestrict);
  shift @components; # Remove effect of leading /

  if(not exists $dynamicloaded{$pathrestrict}) { 
    &walkhandlers_dynamicloader(\@components);
    $dynamicloaded{$pathrestrict}=1;
  }

  foreach my $path (keys %{$handlers{$type}}) {
    if(index($path.'/',$pathrestrict.'/')==0) {
      foreach my $handler (@{$handlers{$type}->{$path}}) {
	&$subtorun($path,$handler->{'sub'}->(''));
      }
    }
    elsif($pathrestrict=~/^$path\/(.*)$/) {
      foreach my $handler (@{$handlers{$type}->{$path}}) {
	&$subtorun($path,$handler->{'sub'}->($1.'/'));
      }
    }
  }
}

sub counthandlers {
  my $count=0;
  while (my ($type,$handlerset)=each %handlers) {
    while (my ($path,$handlerarray)=each %$handlerset) {
      $count+=scalar @$handlerarray;
    }
  }
  return $count;
}

1;
