package PhotoPub::Config;
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw();

use strict;

use PhotoPub::Global qw($error);
use PhotoPub::Utils qw($namere $pathre $rangere &makerightpathstring
		       &checkpath &mkpath &remdups &untaint &md5_uri
                       &parselocalrange);
use PhotoPub::Handlers qw(&installhandler &forallhandlers 
			  &listhandlephoto &handlephoto &parameterhandlephoto
			  &loadingconfig &unloadconfig);
use PhotoPub::Options qw(&initoptions &setoptions);
use PhotoPub::Ages qw(&updateage);
use PhotoPub::FileInfo qw(&mtime &getfiles &isdir);
use PhotoPub::Annots qw(&getannot);
use PhotoPub::Images qw(&canonicalname &picrange);
use PhotoPub::Cache qw(&exifinfo);

# These need to be global because things may want to externally override them
use vars qw($configfile $initbasedir);

use HTML::Entities;
use Time::Local;

#   **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;

my %defaultrefs=(
                 'defaultpath' => 'path',
                 'defaultalbum' => 'album',
                 'defaultalbumstyle' => 'albumstyle',
		 'defaultrangestyle' => 'rangestyle',
		 'defaultembedstyle' => 'embedstyle'
                );

my %templatetypes=('albumtemplates' => 'album',
		   'rangetemplates' => 'range',
		   'embedtemplates' => 'embed',
		   'pagetemplates' => 'page'
		  );

my %linkroottypes=(
                   'albumlinkroot' => 'album',
                   'rangelinkroot' => 'range',
                   'embedlinkroot' => 'embed',
                   'pagelinkroot' => 'page',
                   'displaylinkroot' => 'display'
                  );

my %parallellimittypes=(
			'maxparallelmogrify' => 'mogrify',
			'maxparallelcgi' => 'cgi'
		       );

my %cachedirtypes=(
		   'cachedir' => 'cachefileprefix',
		   'exifcachedir' => 'exifcachefile',
		   'sizecachedir' => 'sizecachefile'
		  );

if(!defined $configfile) {
  my @scriptstat=stat($0) 
    or &$error(type=>'config',message=>"Couldn't stat $0");

#---configfind---
  if($scriptstat[4] < 500) {
    $configfile='/etc/photopubrc';
  } else {
    my @userpw=getpwuid($scriptstat[4])
      or &$error('config',"Couldn't look up the owner of $0");
    $configfile=$userpw[7].'/.photopubrc';
  }
#---endconfigfind---		 
}

my @initbasedir
  = defined $initbasedir 
  ? map { $_ ne '' ? ($_) : () } (split ('/',$initbasedir))
  : ();

&dynamicconfig($configfile,[],[@initbasedir]);

sub readconfig {
  my ($file)=@_;
  my $data=[];
  my @datastack=($data);
  open CONFIG,"<$file"
    or &$error('type' => 'config','message' => "Couldn't open $file");
  my $line=0;
  while(<CONFIG>) {
    $line++;
    my ($item,$value);
    if(($item)=/^\s*($namere)\s*$/) {
      push @{$datastack[0]},
	{ 'item' => $item, 'line' => $line, 'file' => $file };
    } elsif(($item,$value)=/^\s*($namere)\s+([^"]+?)\s*$/) {
      push @{$datastack[0]},
	{ 'item' => $item, 'value' => $value, 
	  'line' => $line, 'file' => $file };
    } elsif(($item,$value)=/^\s*($namere)\s+\"(.*)\"\s*$/) {
      push @{$datastack[0]},
	{ 'item' => $item, 'value' => $value, 
	  'line' => $line, 'file' => $file };
    } elsif(($item)=/^\s*\<($namere)\>/) {
      my $newdata=[];
      push @{$datastack[0]},
	{ 'item' => $item, 'data' => $newdata, 
	  'firstline' => $line, 'file' => $file };
      unshift @datastack,$newdata;
    } elsif(($item,$value)=/^\s*\<($namere)\s+([^\s]+)\>/) {
      my $newdata=[];
      push @{$datastack[0]},
	{ 'item' => $item, 'value' => $value, 'data' => $newdata, 
	  'firstline' => $line, 'file' => $file };
      unshift @datastack,$newdata;
    } elsif(($item,$value)=/^\s*\<($namere)\s+\"(.*)\"\>/) {
      my $newdata=[];
      push @{$datastack[0]},
	{ 'item' => $item, 'value' => $value, 'data' => $newdata, 
	  'firstline' => $line, 'file' => $file };
      unshift @datastack,$newdata;
    } elsif(($item)=/^\s*\<\/($namere)\>/) {
      shift @datastack;
      my $group=$datastack[0]->[scalar @{$datastack[0]}-1];
      $group->{'lastline'}=$line;
      my $groupname=$group->{'item'};
      if($item ne $groupname) {
	&$error(type=>'config',
		message => 
		"Opening tag <$groupname ...> closed by <$item>".
		" at line $line of $file");
      }
    }
  }
  if(scalar @datastack != 1) {
    my $unclosed=$datastack[scalar @datastack-1];
    my $name=$unclosed->[scalar @$unclosed-1]->{'item'};
    &$error('type' => 'config',
	    'message' => "Unclosed <$name ...> tag at line $line of $file");
  }
  return $data;
}

sub dynamicconfig {
  my ($file,$curpath,$basedir)=@_;
  my $loadedtime=0;
  &installhandler('dynamicloader',&makepath($curpath),sub {
		    &$error(type => 'config',
			    message => "Couldn't read $file")
		      unless -r $file;
		    my $mtime=&mtime($file);
		    return 0 if $loadedtime>=$mtime;
		    &unloadconfig($file) if $loadedtime!=0;
		    &loadingconfig($file,sub {
				     &configprocess($curpath,$basedir,
						    &readconfig($file));
				   });
		    $loadedtime=$mtime;
		    return 1;
		  });
}

sub posinfo {
  my ($entry)=@_;
  return (defined $entry->{'line'} 
	  ? " at line ".$entry->{'line'}." of ".$entry->{'file'}
	  : " at lines ".$entry->{'firstline'}."-".$entry->{'lastline'}
	  ." of ".$entry->{'file'});
}

sub startposinfo {
  my ($entry)=@_;
  return (" at line ".$entry->{'firstline'}." of ".$entry->{'file'});
}

sub checkindiv {
  my ($entry)=@_;
  &$error(type=>'config',
	  message=>"$entry->{'item'} can't be a group".&posinfo($entry))
    if defined $entry->{'data'};
}

sub checkgroup {
  my ($entry)=@_;
  &$error(type=>'config',
	  message=>"$entry->{'item'} must be a group".&posinfo($entry))
    unless defined $entry->{'data'};
}

sub checkvalue {
  my ($entry)=@_;
  &$error(type=>'config',
	  message=>"$entry->{'item'} needs an argument".&posinfo($entry))
    unless defined $entry->{'value'};
}

sub checknovalue {
  my ($entry)=@_;
  &$error(type=>'config',
	  message=>"$entry->{'item'} shouldn't have an argument"
	  .&posinfo($entry))
    if defined $entry->{'value'};
}



my %confighandlers=();

sub configprocess {
  my ($curpath,$basedir,$config)=@_;
  foreach my $entry (@$config) {
    my $item=$entry->{'item'};
    my $value=$entry->{'value'};
    my $data=$entry->{'data'};


    if(exists $defaultrefs{$item}) {
      &checkindiv($entry);
      &checkvalue($entry);
      if(scalar @$curpath > 0) {
	&$error(type => 'warning',
		message => "defaults only have effect for path /");
      }
      my $type=$defaultrefs{$item};
      # slightly nasty hack
      $value="$value/" if $type eq 'path' && substr($value,-1,1) ne '/';
      &installhandler('default',&makepath($curpath),sub {
			my ($typewanted)=@_;
			return $value if $type eq $typewanted;
			return undef;
		      });
    } elsif(exists $linkroottypes{$item}) {
      &checkindiv($entry);
      &checkvalue($entry);
      if(scalar @$curpath > 0) {
	&$error(type => 'warning',
		message => "link roots only have effect for path /");
      }
      my $type=$linkroottypes{$item};
      &installhandler('linkroot',&makepath($curpath),sub {
			my ($typewanted)=@_;
			return $value if $type eq $typewanted;
			return undef;
		      });
    } elsif(exists $parallellimittypes{$item}) {
      &checkindiv($entry);
      &checkvalue($entry);
      my $type=$parallellimittypes{$item};
      if(scalar @$curpath > 0) {
	&$error(type => 'warning',
		message => "$item only has effect for path /");
      }
      if($value <= 0) {
	&$error(type => 'config',
		message => "$item must be greater than 0");
      }
      &installhandler('parallellimit',&makepath($curpath),sub {
			my ($wantedtype)=@_;
			return $value if $wantedtype eq $type;
			return undef;
		      });
    } elsif($item eq 'forcemogrify') {
      &checkindiv($entry);
      &setforcemogrify(&makepath($curpath),&truthvalue($value));
    } elsif($item eq 'exifwhentaken') {
      &checkindiv($entry);
      &exifwhentaken(&makepath($curpath)) if &truthvalue($value);
    } elsif(exists $templatetypes{$item}) {
      &checkgroup($entry);
      &checknovalue($entry);
      my %templateshash=();
      foreach my $entry (@$data) {
        $templateshash{$entry->{'item'}}
	  =&dobasedir($basedir,$entry->{'value'});
      }
      &installtemplates($templatetypes{$item},&makepath($curpath),
			\%templateshash);
    } elsif(exists $cachedirtypes{$item}) {
      &checkgroup($entry);
      &checknovalue($entry);
      &configurecachedir(&makepath($curpath),$basedir,$entry);
    } elsif($item eq 'imagedirs') {
      &checkgroup($entry);
      &checknovalue($entry);
      &configureimagedirs(&makepath($curpath),$basedir,$entry);
    } elsif($item eq 'aliasfile') {
      &checkgroup($entry);
      &checknovalue($entry);
      &configurealiasfile(&makepath($curpath),$basedir,$entry);
    } elsif($item eq 'includesfile') {
      &checkgroup($entry);
      &checknovalue($entry);
      &configureincludesfile(&makepath($curpath),$basedir,$entry);
    } elsif($item eq 'infofile') {
      &checkgroup($entry);
      &checknovalue($entry);
      &configureinfofile(&makepath($curpath),$basedir,$entry);
    } elsif($item eq 'photolordindex') {
      &checkgroup($entry);
      &checknovalue($entry);
      &configurephotolordindex(&makepath($curpath),$basedir,$entry);
    } elsif($item eq 'album') {
      &checkgroup($entry);
      &checkvalue($entry);
      my $prefix=&makepath($curpath).'/';
      my $name=$value;
      foreach my $subentry (@$data) {
	if($subentry->{'item'} eq 'title') {
	  # check it's an individual item with a value
	  &installhandler('albumtitle',$prefix.$name,sub {
			    return $subentry->{'value'};
			  });
	} elsif($subentry->{'item'} eq 'style') {
	  # check it's an individual item with a value
	  &installhandler('albumstyle',$prefix.$name,sub {
			    return $subentry->{'value'};
			  });
	} elsif($subentry->{'item'} eq 'link') {
	  # check it's a group with a value
	  my $title;
	  my $level=1;
	  my $album=$subentry->{'value'};
	  &getoptions($subentry,{'title'=>\$title,
				 'level'=>\$level});
	  &$error(type => 'config',
		  message => "Must specify title option at"
		  .&posinfo($subentry))
	    unless defined $title;
	  
	  &configurealbumlink($prefix.$name,
			      substr($album,0,1) eq '/'
			      ? $album : $prefix.$album,
			      $title,
			      $level);
	} elsif($subentry->{'item'} eq 'include') {
	  # check it has a value
	  my $include=$subentry->{'value'};
	  my $options=exists $subentry->{'data'} ? $subentry->{'data'} : [];
	  &configurealbuminclude($prefix.$name,
				 substr($include,0,1) eq '/' 
				 ? $include : $prefix.$include,
				 $options);
	}
      }
    } elsif($item eq 'path') {
      &checkgroup($entry);
      &checkvalue($entry);
      my @path=map { $_ ne '' ? ($_) : () } (split ('/',$value));
      &configprocess([@$curpath,@path],$basedir,$data);
    } elsif($item eq 'basedir') {
      &checkgroup($entry);
      &checkvalue($entry);

      &$error(type => 'config',
	      message => "Directory must be a path".&startposinfo($entry))
	unless &untaint(\$value,$pathre);

      my @dirs=map { $_ ne '' ? ($_) : () } (split ('/',$value));
      &configprocess($curpath,
		     [substr($value,0,1) eq '/' ? () : @$basedir,@dirs],
		     $data);
    } elsif($item eq 'userconfig') {
      &checkgroup($entry);
      &checknovalue($entry);
      my $userlist;
      my $filename;
      &getoptions($entry,{'users'=>\$userlist,
			  'file'=>&deprecated(\$filename),
			  'filename'=>\$filename});

      &$error(type => 'config',
	      message => "Must specify users list".&posinfo($entry))
	unless defined $userlist;

      &$error(type => 'config',
	      message => "Must specify filename option to userconfig"
	      .&posinfo($entry))
	unless defined $filename;
	  
      my @users;
      @users=split(' ',$userlist);

      my %loadedfiles=();
      my %allowedusers=();
      my %filenames=();
      foreach my $user (@users) {
	$allowedusers{$user}=1;
      }
      &installhandler('dynamicloader',&makepath($curpath),sub {
			my ($subpath)=@_;
			my @pathelems=split('/',$subpath);
			my $user=$pathelems[0];
			return 0 unless defined $user;
			if(!defined $allowedusers{$user}) {
			  &$error(type => 'userinput',
				  message => "Unknown user $user");
			}
			my $file;
			# caching will break if user details change
			if(exists $filenames{$user}) {
			  $file=$filenames{$user};
			} else {
			  $file=$filename;
			  my @pwdata=getpwnam($user)
			    or &$error(type => 'config',
				       message => "Unknown user $user");
			  my $home=$pwdata[7];
			  $file=~s/\$USER/$user/ieg;
			  $file=~s/\$HOME/$home/ieg;
			  $filenames{$user}=$file;
			}
			my $mtime=&mtime($file);
			return 0 if defined $loadedfiles{$user}
			  && $loadedfiles{$user}>=$mtime;
			&unloadconfig($file) 
			  if defined $loadedfiles{$user}!=0;
			&loadingconfig($file, sub {
					 &configprocess([@$curpath,$user],
							$basedir,
							&readconfig($file));
				       });
			$loadedfiles{$user}=$mtime;
			return 1;
		      });
    } elsif($item eq 'include') {
      &checkindiv($entry);
      &checkvalue($entry);
      &dynamicconfig(&dobasedir($basedir,$value),$curpath,$basedir);
    } elsif($item eq 'templatealias') {
      &checkindiv($entry);
      &checkvalue($entry);
      my $target=$value;
      $target="$target/" if substr($target,-1,1) ne '/';
      $target=&makepath($curpath).'/'.$target if substr($target,0,1) ne '/';
      while(my ($plural,$type)=each %templatetypes) {
	my $handler=$type."template";
	# recursion breaking
	my $inside=0;
	my $path=&makepath($curpath);
	&installhandler($handler,$path,sub {
			  my ($subpath)=@_;
			  if($inside) {
			    # if you alias /foo to /foo/bar, then anytime 
			    # anything under /foo isn't found we end up here
#			    &$error(type=>'config',
#				    message=>'Possible recursion in '
#                                              ."templatealias of $path/ to "
#                                              ."$target");
			    return undef;
			  }
			  $inside=1;
			  my $ret=&handlephoto($handler,$target.$subpath);
			  $inside=0;
			  return $ret;
			});
      }
    } elsif(exists $confighandlers{$item}) {
      $confighandlers{$item}->($entry);
    } else {
      # warn about unrecognised option
    }
  }
}

sub dobasedir {
  my ($basedir,$value)=@_;
  my $retdir = (substr($value,0,1) eq '/'
		? $value 
		: (&makepath($basedir).'/'.$value));
  chop $retdir if substr($retdir,-1,1) eq '/';
  return $retdir;
}

# Take Care: perl logic will often do the wrong thing if you aren't 
#            careful, as values of 0 mean things to us
sub truthvalue {
  my $value = shift;
  my $default = shift;

  # Don't do 'unless($default)' as $default=0 is meaningful to us
  unless(defined $default) { $default = 1; }
  if($default eq "")       { $default = 1; }

  unless(defined $value) { return $default; }
  if( $value eq '' )     { return $default; }

  my $firstchar=lc(substr($value,0,1));
  return 1 if $firstchar eq 'y' || $firstchar eq 't' || $firstchar eq '1';
  return 0 if $firstchar eq 'n' || $firstchar eq 'f' || $firstchar eq '0';
  &$error(type => 'config',
	  message => "Invalid value '$value' for boolean option");
}

sub makepath {
  my ($path)=@_;
  my $ret='';
  foreach my $entry (@$path) {
    $ret.="/$entry";
  }
  return $ret;
}

sub getoptions {
  my ($topentry,$spec)=@_;
  foreach my $entry (@{$topentry->{'data'}}) {
    if(exists $spec->{$entry->{'item'}}) {
      my $v=$spec->{$entry->{'item'}};
      my $gettruthvalue=0;
      if(ref $v eq 'HASH') {
	my $entryref=$v->{'entry'};
	$$entryref=$entry if exists $v->{'entry'};
	$gettruthvalue=$v->{'gettruthvalue'} 
	  if exists $v->{'gettruthvalue'};
	&$error(type=>'warning',
		message=>"Use of deprecated option '".$entry->{'item'}."'"
		.&posinfo($entry)) 
	  if exists $v->{'deprecated'} && $v->{'deprecated'};
        $v=$v->{'ref'};
      }
      my $value=$entry->{'value'};
      $value='' unless defined $value; # if it's there but blank
      if(ref $v eq 'ARRAY') {
	push @$v,$value;
      } elsif(ref $v eq 'SCALAR') {
	$$v=$value;
      }
      $$v=&truthvalue($$v) if $gettruthvalue;
    }
  }
}

sub gettruthvalue {
  my ($in)=@_;
  $in = {'ref' => $in} if ref $in eq 'SCALAR';
  $in->{'gettruthvalue'} = 1;
  return $in;
}

sub deprecated {
  my ($in)=@_;
  $in = {'ref' => $in} if ref $in eq 'SCALAR';
  $in->{'deprecated'} = 1;
  return $in;
}

sub configurecachedir {
  my ($path,$basedir,$topentry)=@_;
  my $dir;
  my $direntry;
  my $digits=0;
  my $prefix='';
  my $suffix='';

  &getoptions($topentry,{ 'dir' => { 'ref' => \$dir,
				     'entry' => \$direntry },
			  'digits' => \$digits,
			  'prefix' => \$prefix,
			  'suffix' => \$suffix });

  &$error(type => 'config',
	  message => "Must specify dir option to "
	  .$topentry->{'item'}.&posinfo($topentry))
    unless defined $dir;

  &$error(type => 'config',
	  message => "Directory must be a path".&posinfo($direntry))
    unless &untaint(\$dir,$pathre);

  $dir=&dobasedir($basedir,$dir);

  installhandler($cachedirtypes{$topentry->{'item'}},$path,sub {
		   my ($photo)=@_;
		   if(my ($subpath,$num)=($photo=~/^((?:$pathre\/)?)(\d+)$/)) {
		     mkpath($dir,$subpath);
		     return ("$dir/$subpath$prefix"
			     .'0' x ($digits-length($num))
			     .$num.$suffix);
		   } else {
		     &$error(type => 'userinput',
			     message => "Invalid photo $photo");
		   }
		 });
}

sub configureimagedirs {
  my ($path,$basedir,$topentry)=@_;
  my $prefix = '';
  my $digits = 0;
  my $suffix = '';
  my $casesensitive = 0;
  my @dirs = ();

  &getoptions($topentry,{'dir' => \@dirs,
			 'prefix' => \$prefix,
			 'digits' => \$digits,
			 'suffix' => \$suffix,
			 'casesensitive' => &gettruthvalue(\$casesensitive)});

  &$error(type=>'config',
	  message=>"Must specify at least one dir option to imagedirs"
	  .&posinfo($topentry)) 
    unless @dirs;

  if($debug >= 2) {
    print "imagefile: $path ".join(',',@dirs)."\n";
  }

  for my $i (0..$#dirs) {
    $dirs[$i]=&dobasedir($basedir,$dirs[$i]);
  }

  installhandler('imagefile',$path,sub {
		   my ($photo)=@_;
		   my ($subpath,$num);
		   ($subpath,$num)=($photo=~/((?:.*\/)?)(\d+)/)
		     or &$error(type=>'userinput',
				message=>qq{Invalid photo name "$path/$photo"});
		   my $file=$subpath.$prefix.'0' x ($digits-length($num))
		     .$num.$suffix;
		   foreach my $dir (@dirs) {
		     return "$dir/$file" if &checkpath("$dir/$file");
		   }
		   return undef;
		 });
  installhandler('existsphotos',$path,sub {
		   my ($subpath)=@_;
		   return sub {
		     my ($nums)=@_;
		     my @ret=();
		     foreach my $num (@$nums) {
		       my $file=$subpath.'/'.$prefix.'0' x ($digits-length($num))
			 .$num.$suffix;
		       foreach my $dir (@dirs) {
			 if(&checkpath("$dir/$file")) {
			   push @ret,$num;
			   last;
			 }
		       }
		     }
		     return \@ret;
		   }
		 });
  installhandler('photolist',$path,sub {
		   my ($subpath)=@_;
		   my $photos=[];
		   foreach my $dir (@dirs) {
		     next if !checkpath("$dir/$subpath");

		     foreach (&getfiles("$dir/$subpath")) {
                       if($casesensitive) {
  		          if(/^$prefix(0*)([1-9]\d*)$suffix$/ 
			     && (length($1)+length($2)==$digits 
                                   || $digits==0)) {
  			    push @$photos,$2;
                          }
                       } else {
  		          if(/^$prefix(0*)([1-9]\d*)$suffix$/i 
			     && (length($1)+length($2)==$digits
                                   || $digits==0)) {
  			    push @$photos,$2;
                          }
		       }
		     }
		   }
		   return $photos;
		 });
  installhandler('enumsubpaths',$path,sub {
		   my ($subpath)=@_;
		   my %subpaths=();
		   foreach my $dir (@dirs) {
		     next if !checkpath($dir);
		     foreach my $subdir (&enumsubdirs($dir,$subpath)) {
		       # switch / from beginning to end
		       $subdir=substr($subdir,1)."/" if $subdir; 

		       my $mtime=(stat($dir.'/'.$subdir))[9];
		       $subpaths{$subdir}=$mtime unless 
			 exists $subpaths{$subdir} 
			   && $subpaths{$subdir}>=$mtime;
		     }
		   }
		   return [sort { $subpaths{$a} <=> $subpaths{$b} } 
			   (keys %subpaths)];

		 });

}
		   
sub setforcemogrify {
  my ($path,$forcemogrify)=@_;
  &installhandler('forcemogrify',$path,sub {
		   return $forcemogrify;
		 });
}

sub exifwhentaken {
  my ($path)=@_;
  &installhandler('whentaken',$path,sub {
		    my ($subpath)=@_;
		    my $info=&exifinfo("$path/$subpath");
		    if(defined $info) {
		      my $whenstr=$info->{'DateTimeOriginal'};
		      if(defined $whenstr) {
			my ($year,$month,$mday,$hour,$min,$sec)
			  =split(/[:\s]+/,$whenstr)
                              or &$error(type=>'picture',
                                         message=>"Error in EXIF info for $path/$subpath");
			return &timegm($sec,$min,$hour,$mday,$month-1,$year);
		      }
		    }
		    return undef;
		  });
}

sub installtemplates {
  my ($type,$path,$templates)=@_;
  &installhandler($type.'template',$path,sub {
		    my ($style)=@_;
		    return $templates->{$style};
		  });
}


sub configurealiasfile {
  my ($path,$basedir,$entry)=@_;

  my $aliasfilebasedir;
  my $aliasfilename;
  my $opaque=0;

  &getoptions($entry,{'dir' => \$aliasfilebasedir,
		      'filename' => \$aliasfilename,
		      'opaque' => &gettruthvalue(\$opaque)});

  &$error(type=>'config',
	  message=>"Must specify dir option to aliasfile".&posinfo($entry))
    unless defined $aliasfilebasedir;

  $aliasfilebasedir=&dobasedir($basedir,$aliasfilebasedir);

  &$error(type=>'config',
	  message=>"Must specify filename option to aliasfile"
	  .&posinfo($entry))
    unless defined $aliasfilename;


  my %aliases=();

  my %age=();

  my $parsealiasfile=sub {
    my ($subpath)=@_;
    my $aliasfile=$aliasfilebasedir.'/'.$subpath.$aliasfilename;

    return if defined $age{$subpath} 
           && -f $aliasfile 
           && &mtime($aliasfile)<=$age{$subpath};

    if(!open ALIAS,"<$aliasfile") {
      return;
    }
    $age{$subpath}=&mtime($aliasfile);

    $aliases{$subpath}={};

    my %defaultinherit=();

    while(<ALIAS>) {
      s/\r$//;
      if(/^defaultinherit (.*)$/) {
	my @inherits=split(/\s+/,$1);
	%defaultinherit=();
	foreach my $annottype (@inherits) {
	  $defaultinherit{$annottype}=1;
	}
      } elsif(/^alias (\d+) ($pathre)(.*)$/) {
	my %inherit=();
        my $photo=$2;
        $photo="$path/$photo" unless substr($2,0,1) eq '/';
	if($3 eq '') {
	  %inherit=%defaultinherit;
	} else {
	  my @inherits=split(/\s+/,$3);
	  foreach my $annottype (@inherits) {
	    $inherit{$annottype}=1;
	  }    
	}
	$aliases{$subpath}->{$1}={'photo' => $photo,
				  'inherit' => \%inherit};
      } elsif(/^alias (\d+)\-(\d+) ((?:step \d+ )?)($pathre)(.*)$/) {
	my $sourcefrom=$1;
	my $sourceto=$2;
        my $sourcestepstr=$3;
        my $targetpath=$4;
        my $inherit=$5;
        my $sourcestep;

        ($sourcestep) = ($sourcestepstr =~ /^step (\d+) $/) or $sourcestep=1;

	my %inherit=();
	if($inherit eq '') {
	  %inherit=%defaultinherit;
	} else {
	  my @inherits=split(/\s+/,$inherit);
	  foreach my $annottype (@inherits) {
	    $inherit{$annottype}=1;
	  }    
	}

	my ($root,$targetfrom,$targetto) 
                   = $targetpath=~/^(?:(.*\/)?)(\d+)\-(\d+)$/ 
	  or &$error(type =>'internal',message=>"Couldn't parse $targetpath");

        $root="$path/$root" unless substr($root,0,1) eq '/';

	($targetto-$targetfrom)*$sourcestep == $sourceto-$sourcefrom
	  or &$error(type =>'config',
		     message=>
		     "Different sized source and target alias ranges in $_");
	
	my $targetnum=$targetfrom;
        my $sourcenum=$sourcefrom;
	while($targetnum<=$targetto) {
	  $aliases{$subpath}->{$sourcenum}={'photo' => $root.$targetnum,
					    'inherit' => \%inherit};
          $sourcenum+=$sourcestep;
          $targetnum++;
	}
      }
	
    }
    close ALIAS;
  };
  &setupaliases($path,\%aliases,$opaque,$parsealiasfile,$aliasfilebasedir,
		\%age);
}

sub configureincludesfile {
  my ($path,$basedir,$entry)=@_;

  my $includesfilebasedir;
  my $includesfilename;
  my $opaque=0;

  &getoptions($entry,{'dir' => \$includesfilebasedir,
		      'filename' => \$includesfilename,
		      'opaque' => &gettruthvalue(\$opaque)});

  &$error(type=>'config',
	  message=>"Must specify dir option to includesfile".&posinfo($entry))
    unless defined $includesfilebasedir;

  $includesfilebasedir=&dobasedir($basedir,$includesfilebasedir);

  &$error(type=>'config',
	  message=>"Must specify filename option to includesfile"
	  .&posinfo($entry))
    unless defined $includesfilename;

  my %aliases=();

  my %age=();

  my $parseincludesfile=sub {
    my ($subpath)=@_;
    my $includesfile=$includesfilebasedir.'/'.$subpath.$includesfilename;

    return if defined $age{$subpath} 
           && -f $includesfile 
           && &mtime($includesfile)<=$age{$subpath};

    if(!open INCLUDES,"<$includesfile") {
      return;
    }
    $age{$subpath}=&mtime($includesfile);

    $aliases{$subpath}={};

    my %defaultinherit=();
    my @includes=();

    while(<INCLUDES>) {
      s/\r$//;
      if(/^defaultinherit (.*)$/) {
	my @inherits=split(/\s+/,$1);
	%defaultinherit=();
	foreach my $annottype (@inherits) {
	  $defaultinherit{$annottype}=1;
	}
      } elsif(/^include ($rangere)\s*((?:adjustwhentaken\s+[\+\-]?\d+)?)(.*)$/) {
	my %inherit=();
	my $range=$1;
	my $adjwhen=$2;
	my $inherits=$3;
	my $adjwhenfactor=0;
	if($adjwhen=~/^adjustwhentaken\s+\+?(\-?\d+)$/) {
	  $adjwhenfactor=$1;
	}
	if($inherits eq '') {
	  %inherit=%defaultinherit;
	} else {
	  my @inherits=split(/\s+/,$inherits);
	  foreach my $annottype (@inherits) {
	    $inherit{$annottype}=1;
	  }    
	}
	foreach my $photo (&picrange($range)) {
	  push @includes,{photo => $photo,
			  inherit => \%inherit,
			  adjustwhentaken => $adjwhenfactor};
	}
      } elsif(/^sortbywhentaken\s+$/) {
	foreach my $include (@includes) {
	  if(!exists $include->{'whentaken'}) {
	    $include->{'whentaken'}
	      =&handlephoto('whentaken',$include->{'photo'});
	    if(defined $include->{'whentaken'}) {
	      if(defined $include->{'adjustwhentaken'}) {
		$include->{'whentaken'}+=$include->{'adjustwhentaken'};
	      }
	    } else {
	      $include->{'whentaken'}=0;
	    }
	  }
	}
	@includes=sort { $a->{'whentaken'} <=> $b->{'whentaken'} } @includes;
      }
    }
    close INCLUDES;
    my $num=1;
    foreach my $include (@includes) {
      delete $include->{'whentaken'};
      $aliases{$subpath}->{$num}=$include;
      $num++;
    }
  };
  &setupaliases($path,\%aliases,$opaque,$parseincludesfile,
		$includesfilebasedir,\%age);
}


sub setupaliases {
  my ($path,$aliases,$opaque,$parsealiasfile,$aliasfilebasedir,$age)=@_;
  &installhandler('imagefile',$path,sub {
		    my ($photo)=@_;
		    my ($subpath,$num);
		    ($subpath,$num)=($photo=~/((?:.*\/)?)(\d+)/)
		     or &$error(type=>'userinput',
                                message=>qq{Invalid photo name "$path/$photo"});

		    &$parsealiasfile($subpath);

		    if(exists $aliases->{$subpath}->{$num}) {
		      &handlephoto('imagefile',
				   $aliases->{$subpath}->{$num}->{'photo'});
		    } else {
		      return undef;
		    }
		  });
  &installhandler('existsphotos',$path,sub {
		    my ($subpath)=@_;
		    &$parsealiasfile($subpath);
		    return sub {
		      my ($nums)=@_;
		      my @ret=();
		      # the stupid easy way to do it
		      foreach my $num (@$nums) {
			push @ret,$num 
			  if exists $aliases->{$subpath}->{$num}
			    && defined &handlephoto('imagefile',
				    $aliases->{$subpath}->{$num}->{'photo'});
		      }
		      return \@ret;
		    }
		  });
  &installhandler('photolist',$path,sub {
		    my ($subpath)=@_;

		    &$parsealiasfile($subpath);

		    my $photos=[];
		    if(exists $aliases->{$subpath}) {
		      foreach my $num (keys %{$aliases->{$subpath}}) {
			push @$photos,$num;
		      }
		    }
		    return $photos;
		  });

  &installhandler('enumsubpaths',$path,sub {
		    my ($subpath)=@_;
		    my %subpaths=();
		    my $dir=$aliasfilebasedir;
		    if(&checkpath($dir)) {
		      foreach my $subdir (enumsubdirs($dir,$subpath)) {
			# switch / from beginning to end
			$subdir=substr($subdir,1)."/" if $subdir; 

			my $mtime=(stat($dir.'/'.$subdir))[9];
			$subpaths{$subdir}=$mtime unless 
			  exists $subpaths{$subdir} 
			    && $subpaths{$subdir}>=$mtime;
		      }
		    }
		    return [sort { $subpaths{$a} <=> $subpaths{$b} } 
			    (keys %subpaths)];
		    
		  });

# lots of duplicated code patterns to clean up..

  &installhandler('cachefileprefix',$path,sub {
		    my ($photo)=@_;
		    my ($subpath,$num)=($photo=~/((?:$pathre\/)?)(\d+)/);
		    if(exists $aliases->{$subpath}->{$num}) {
		      return 
			&handlephoto('cachefileprefix',
				     $aliases->{$subpath}->{$num}->{'photo'}
				    );
		    } else {
		      return undef;
		    }
		  });

  if($debug >= 3) {
    print "canonical name for $path installed\n";
  }
  &installhandler('canonicalname',$path,sub {
		    my ($photo)=@_;
		    if($debug >= 3) {
		      print "canonical: $path/$photo\n";
		    }
		    my ($subpath,$num)=($photo=~/((?:$pathre\/)?)(\d+)/);
		    if(exists $aliases->{$subpath}->{$num}) {
		      my $next=$aliases->{$subpath}->{$num}->{'photo'};
		      return &canonicalname($next);
		    } else {
		      return undef;
		    }
		  }) unless $opaque;

  my $getannot=sub {
    my ($annottype,$photo)=@_;
    my ($subpath,$num);
    ($subpath,$num)=($photo=~/((?:.*\/)?)(\d+)$/)
      or &$error(type=>'internal',
                 message=>"Couldn't parse photo $photo");
    &$parsealiasfile($subpath);
    if(exists $aliases->{$subpath}->{$num}) { 
      &updateage($age->{$subpath});
      if(exists $aliases->{$subpath}->{$num}->{'inherit'}->{$annottype}) {
	return &getannot($aliases->{$subpath}->{$num}->{'photo'},$annottype);
      } 
    }
    return undef;
  };

  &installhandler('description',$path,sub {
		    return &$getannot('description',@_);
		  });
  
  &installhandler('options',$path,sub {
		    return &$getannot('options',@_);
		  });

  &installhandler('whentaken',$path,sub {
		    my ($photo)=@_;
		    my ($subpath,$num);
		    ($subpath,$num)=($photo=~/((?:.*\/)?)(\d+)$/)
		      or &$error(type=>'internal',
                                 message=>"Couldn't parse photo $photo");
		    &$parsealiasfile($subpath);
		    if(exists $aliases->{$subpath}->{$num}) {
		      my $aliasinfo=$aliases->{$subpath}->{$num};
		      my $whentaken=&handlephoto('whentaken',
						 $aliasinfo->{'photo'});
		      if(defined $whentaken) {
			if(exists $aliasinfo->{'adjustwhentaken'}) {
			  $whentaken+=$aliasinfo->{'adjustwhentaken'};
			}
			return $whentaken;
		      }
		    }
		    return undef;
		  });

		    

  &installhandler('test',$path,sub {
		    &$parsealiasfile(shift);
		  });

}



sub configureinfofile {
  my ($path,$basedir,$topentry)=@_;

  my $infofilebasedir;
  my $infofilename;

  my $allowhtml=0;
  my $allowlower=0;
  my $listblankdir=0;
  my $dirdepthaslvl=0;
  my @makealbums=();

  &getoptions($topentry,{'dir' => \$infofilebasedir,
			 'filename' => \$infofilename,
			 'allowhtml' => &gettruthvalue(\$allowhtml),
			 'allowlower' => &gettruthvalue(\$allowlower),
			 'allowdescribelower' 
			 => &deprecated(&gettruthvalue(\$allowlower)),
			 'listblankdir' => &gettruthvalue(\$listblankdir),
			 'dirdepthaslvl' => &gettruthvalue(\$dirdepthaslvl),
			 'makealbum' => \@makealbums});

  &$error(type=>'config',
	  message=>"Must specify dir option to infofile".&posinfo($topentry))
    unless defined $infofilebasedir;

  $infofilebasedir=&dobasedir($basedir,$infofilebasedir);

  &$error(type=>'config',
	  message=>"Must specify filename option to infofile"
	  .&posinfo($topentry)) 
    unless defined $infofilename;
			 
  my %annotations=();
  my %groups=();

  my %age=();

  my $setannotdescr=sub {
    my ($infopath,$subpath,$num,$descr)=@_;
    $annotations{$infopath}->{$subpath}->{$num}={} 
      unless defined $annotations{$infopath}->{$subpath}->{$num};
    $annotations{$infopath}->{$subpath}->{$num}->{'description'}=
      $allowhtml ? $descr : &encode_entities($descr);
  };

  my $setannotwhentaken=sub {
    my ($infopath,$subpath,$num,$whentaken)=@_;
    $annotations{$infopath}->{$subpath}->{$num}={} 
      unless defined $annotations{$infopath}->{$subpath}->{$num};
    $annotations{$infopath}->{$subpath}->{$num}->{'whentaken'}=$whentaken;
  };
  
  my $setannotoptions=sub {
    my ($infopath,$subpath,$num,$options)=@_;
    $annotations{$infopath}->{$subpath}->{$num}={} 
      unless defined $annotations{$infopath}->{$subpath}->{$num};
    $annotations{$infopath}->{$subpath}->{$num}->{'options'}=&initoptions() 
      unless defined $annotations{$infopath}->{$subpath}->{$num}->{'options'};
    setoptions($annotations{$subpath}->{$subpath}->{$num}->{'options'},
	       $options);
  };

  my $doparseinfofile=sub {
    my ($infopath)=@_;
    my $infofile=$infofilebasedir.'/'.$infopath.$infofilename;

    # Check if file has changed, or if the file doesn't exist then
    # if the default has been loaded already
    return if defined $age{$infopath} 
      && (-f $infofile ? &mtime($infofile)==$age{$infopath} 
	               : $age{$infopath}==0);

    $groups{$infopath}={};
    $annotations{$infopath}={};

    my $fullpath="$path/$infopath";
    chop $fullpath;
    

    if(!open INFO,"<$infofile") {
      # no info file for this directory found, make up a basic default group
      # which contains all the photos in the relevant subdirectory, as long
      # as there is at least one, or the user wants blank directories

      my $lvl = 1;
      if( $dirdepthaslvl ) {
         my @parts=split(/\//,$fullpath);
         $lvl = scalar(@parts) - 1;
      }

      my $photos = &listhandlephoto('photolist',$fullpath);
      my $photocount = scalar @$photos;

      if( $photocount>=1 || $listblankdir ) {
         push @{$groups{$infopath}->{''}},
	   {'range' => $infopath.'*',
	    'description' => "Directory $fullpath",
	    'level' => $lvl};
      }
      $age{$infopath}=0;
      return;
    }

# I think this warning is spurious since if you have imagedirs
# it'll never fire anyway...
#    if( $photocount == 0 ) {
#      # Check for subdirs
#      my $subcount = 0;
#
#      forallhandlers('enumsubpaths',$fullpath,sub {
#		    my ($thispath,$subpaths)=@_;
#		    foreach my $thissubpath (@$subpaths) {
#			$subcount++;
#		    }
#	     });
#
#      &$error(type => 'warning',
#           message => "No pictures found in path $fullpath") if $subcount==0;
#    }

    $age{$infopath}=&mtime($infofile);
    my $pre = $allowlower ? '[\w\-\_\.\/]+\/' : '';
    while(<INFO>) {
      s/\r$//;
      if(my ($options,$subpath,$rng,$desc) = /^group\s+(\[[^\[\]]*\])?\s*\/?($pre)?([\d\-\,\*]+)\s+(.*)$/ ) {
	$subpath='' if !defined $subpath;
	my $workpath=$infopath.$subpath;
        my $range=$workpath.$rng;

	my $name;
	if(defined $options) {
	  $options=~s/^\[(.*)\]$/$1/;
	  my @options=split /\s+/,$options;
	  foreach (@options) {
	    if(/^name=([\w\_\.]+)$/) {
	      $name=$1;
	    }
	  }
	}
	push(@{$groups{$infopath}->{$subpath}},
	     {'range' => $range, 
	      'description' => $allowhtml ? $desc : &encode_entities($desc),
	      'level' => 1,
	      (defined $name ? ('name' => $name) : ())});
      }
      if(my ($lvl,$options,$subpath,$rng,$desc) 
	 = /^subgroup\s+(\d+)\s+(\[[^\[\]]*\])?\s*\/?($pre)?([\d\-\,\*]+)\s+(.*)$/) {
	$subpath='' if !defined $subpath;
	my $workpath=$infopath.$subpath;
        my $range=$workpath.$rng;

	my $name;
	if(defined $options) {
	  $options=~s/^\[(.*)\]$/$1/;
	  my @options=split /\s+/,$options;
	  foreach (@options) {
	    if(/^name=([\w\_\.]+)$/) {
	      $name=$1;
	    }
	  }
	}

	push(@{$groups{$infopath}->{$subpath}},
	     {'range' => $range,
	      'description' => $allowhtml ? $desc : &encode_entities($desc),
	      'level' => $lvl,
	      (defined $name ? ('name' => $name) : ())});
      }
      if(my ($subpath,$num,$desc)=/^describe \/?($pre)?(\d+) (.*)$/) {
	$subpath='' if !defined $subpath;
	&$setannotdescr($infopath,$subpath,$num,$desc);
      }
      if(my ($subpath,$num,$red,$green,$blue)
	 = /^adjust \/?($pre)?(\d+) ([\d\.]+) ([\d\.]+) ([\d\.]+)/)
	{
	  $subpath='' if !defined $subpath;
	  &$setannotoptions($infopath,$subpath,$num,
			    {'red' => $red,'green' => $green,'blue' => $blue});
	}
      if(my ($subpath,$rng,$rot)=/^rotate \/?($pre)?([\d\-\,]+)\s+([\d\.]+)\s*/) {
	$subpath='' if !defined $subpath;
        # TODO copy this generalisation for ranges to the other photo modification options
        &parselocalrange($rng, sub {
           my ($num) = @_;
           &$setannotoptions($infopath,$subpath,$num,{'rotate' => $rot});
           return 1;
        });
      }
      if(my ($subpath,$num,$rot)
	 = /^rotate \/?($pre)?(\d+)\s+([\d\.]+)\s+autocrop\s*/) {
	$subpath='' if !defined $subpath;
	&$setannotoptions($infopath,$subpath,$num,{'rotate' => $rot.'a'});
      }
      if(my ($subpath,$num,$gamma)=/^gamma \/?($pre)?(\d+) ([\d\.]+)/) {
	$subpath='' if !defined $subpath;
	&$setannotoptions($infopath,$subpath,$num,{'gamma' => $gamma});
      }
      if(my ($subpath,$num,$crop)=/^crop \/?($pre)?(\d+) ([x\d\+\-\%]+)/) {
	$subpath='' if !defined $subpath;
	&$setannotoptions($infopath,$subpath,$num,{'crop' => $crop});
      }
      if(my ($subpath,$num,$whentaken)=/^whentaken \/?($pre)?(\d+) (\d+)/) {
	$subpath='' if !defined $subpath;
	&$setannotwhentaken($infopath,$subpath,$num,$whentaken);
      }
    }
    close INFO;
  };

  my $splits;
  if($allowlower) {
    $splits=sub {
      my ($subpath)=@_;
      my @ret=();
      my @components=split('/',$subpath);
      my $limit=scalar @components;
      foreach my $i (0..$limit) {
	push @ret,[&makerightpathstring(@components[0..($i-1)]),
		   &makerightpathstring(@components[$i..($limit-1)])];
      }
      return @ret;
    };
  } else {
    $splits=sub {
      my ($subpath)=@_;
      return ([$subpath,'']);
    };
  }
  
  my $getinfo=sub {
    my ($subpath)=@_;
    foreach my $pathsplit (&$splits($subpath)) {
      my ($infopath,$sspath)=@$pathsplit;
      &$doparseinfofile($infopath);
    }
  };

  my $getgroups=sub {
    my ($subpath)=@_;
    my $ret=[];
    foreach my $pathsplit (&$splits($subpath)) {
      my ($infopath,$sspath)=@$pathsplit;
      &$doparseinfofile($infopath);
      &updateage($age{$infopath});
      push @$ret,@{$groups{$infopath}->{$sspath}}
	if defined $groups{$infopath}->{$sspath};
    }
    return $ret;
  };

  my $getannot=sub {
    my ($annottype,$photo)=@_;
    my ($subpath,$num);
    ($subpath,$num)=($photo=~/((?:.*\/)?)(\d+)$/)
      or &$error(type=>'internal',
		 message=>"Couldn't parse photo $photo");
    foreach my $pathsplit (&$splits($subpath)) {
      my ($infopath,$sspath)=@$pathsplit;
      &$doparseinfofile($infopath);
      &updateage($age{$infopath});
      if(exists $annotations{$infopath}->{$sspath}->{$num}) { 
	return $annotations{$infopath}->{$sspath}->{$num}->{$annottype};
      }
    }
    return undef;
  };


  installhandler('photogroups',$path,sub {
		   my ($subpath)=@_;
		   my $allgroups=[];
		   my @subpaths=();
		   my $fullpath=$path.'/'.$subpath;
#		   return if !checkpath($fullpath);
		   chop $fullpath;

# This depends on there being an enumsubpaths handler to work at all.
# This doesn't seem entirely sensible!

		   forallhandlers('enumsubpaths',$fullpath,sub {
				    my ($thispath,$subpaths)=@_;
				    foreach my $thissubpath (@$subpaths) {
				      push @subpaths,
					substr($thispath.$thissubpath,
					       length($path));
				    }
				  });

# should the behaviour of collecting subpaths too be configurable?

		   foreach my $thissubpath (@subpaths) {
		     my $groups=&$getgroups($thissubpath);
		     updateage($age{$thissubpath});
		     push @$allgroups,@$groups;
		   }
		   return $allgroups;
		 });

  installhandler('description',$path,sub {
		   return &$getannot('description',@_);
		 });

  installhandler('options',$path,sub {
		   return &$getannot('options',@_);
		 });

  installhandler('whentaken',$path,sub {
		   return &$getannot('whentaken',@_);
		 });

  installhandler('test',$path,sub {
		   &$getinfo(shift);
		 });

  foreach my $album (@makealbums) {
      installhandler('album',"$path/$album",sub {
		       # ignore the residual path
		       my $allitems=[];
		       my @subpaths=();
		       forallhandlers('enumsubpaths',$path,sub {
					my ($thispath,$subpaths)=@_;
					foreach my $thissubpath (@$subpaths) {
					  push @subpaths,
					    substr($thispath.$thissubpath,
						   length($path));
					}
				      });

		       # Ensure we get the paths in a sensible order
		       @subpaths = sort(@subpaths);
		       
		       foreach my $thissubpath (@subpaths) {
			 my $groups=&$getgroups($thissubpath);
			 foreach my $group (@$groups) {
			   my $item={type => 'group',
				     range => $path.'/'.$group->{'range'},
				     description => $group->{'description'},
				     level => $group->{'level'}
				    };
			   $item->{'name'}=$group->{'name'}
			     if exists $group->{'name'};
			   push @$allitems,$item;
			 }
		       }
		       return $allitems;
		     });
      installhandler('rangeinfo',"$path/$album",sub {
		       # ignore the residual path
		       return sub {
			 my ($range)=@_;
			 my @subpaths=();

			 forallhandlers('enumsubpaths',$path,sub {
					  my ($thispath,$subpaths)=@_;
					  foreach my $thissubpath
					    (@$subpaths) {
					      push @subpaths,
						substr($thispath.$thissubpath,
						       length($path));
					    }
					});

			 # perhaps the list of groups should be precomputed 
			 # instead of doing a linear search each time?

			 foreach my $thissubpath (@subpaths) {
			   my $groups=&$getgroups($thissubpath);

			   foreach my $group (@$groups) {
			     if($range eq $path.'/'.$group->{'range'}) {
			       &updateage($age{$thissubpath});
			       return $group;
			     }
			   }
			 }
			 return undef;
		       }
		     });

    }
}

sub configurephotolordindex {
  my ($path,$basedir,$topentry)=@_;

  my @basedirs=();
  my @prefixes=();
  my @suffixes=();
  my $filename;
  my $allowhtml=0;

  &getoptions($topentry,{'dir' => \@basedirs,
			 'filename' => \$filename,
			 'descprefix' => \@prefixes,
			 'descsuffix' => \@suffixes,
			 'allowhtml' => &gettruthvalue(\$allowhtml)});

  &$error(type=>'config',
	  message=>"Must specify at least one dir option to photolordindex"
	  .&posinfo($topentry))
    unless @basedirs;

  &$error(type=>'config',
	  message=>"Must specify at least one descprefix option to photolordindex"
	  .&posinfo($topentry))
    unless @prefixes;

  &$error(type=>'config',
	  message=>"Must specify at least one descsuffix option to photolordindex"
	  .&posinfo($topentry))
    unless @suffixes;

  &$error(type=>'config',
	  message=>"Must specify filename option to photolordindex"
	  .&posinfo($topentry))
    unless defined $filename;

  for my $i (0..$#basedirs) {
    $basedirs[$i]=&dobasedir($basedir,$basedirs[$i]);
  }

  my %annotations=();

  my %age=();

  my $setannotdescr=sub {
    my ($age,$num,$descr)=@_;
    $annotations{$num}={} unless defined $annotations{$num};
    $annotations{$num}->{'age'}=$age;
    $annotations{$num}->{'description'}=
      $allowhtml ? $descr : &encode_entities($descr);
  };
  
  my $parsefile;
  $parsefile=sub {
    # Doesn't remove old descriptions when a file changes
    foreach my $basedir (@basedirs) {
      my $file=$basedir.'/'.$filename;
      # Check if file has changed
      next if defined $age{$file} 
	&& -f $file 
	  && &mtime($file)<=$age{$file};

      my $photos = &listhandlephoto('photolist',$path);
      my $photocount = scalar @$photos;
      
      next unless open INDEX,"<$file";
      
      $age{$file}=&mtime($file);

      while(<INDEX>) {
	s/\r$//;
	foreach my $prefix (@prefixes) {
	  foreach my $suffix (@suffixes) {
	    if(/^${prefix}0*([1-9]\d*)$suffix\s+(.*)$/) {
	      &$setannotdescr($age{$file},$1,$2);
	    }
	  }
	}
      }
      close INDEX;
    }
  };

  my $getannot=sub {
    my ($annottype,$photo)=@_;
    my ($subpath,$num);
    ($subpath,$num)=($photo=~/((?:.*\/)?)(\d+)$/)
      or &$error(type=>'internal',
                 message=>"Couldn't parse photo $photo");
    return undef unless $subpath eq '';
    &$parsefile();
    if(exists $annotations{$num}) { 
      updateage($annotations{$num}->{'age'});
      return $annotations{$num}->{$annottype};
    } else {
      return undef;
    }
  };

  installhandler('description',$path,sub {
		   return &$getannot('description',@_);
		 });


  installhandler('test',$path,sub {
		   &$parsefile(shift);
		 });

}


sub configurealbumlink {
  my ($from,$to,$title,$level)=@_;
  &installhandler('album',$from,sub {
		    return [{type => 'link',
			     album => $to,
			     title => $title,
			     level => $level}];
		  });
}

sub configurealbuminclude {
  my ($from,$include,$options)=@_;
  my %titleoverrides=();
  foreach my $option (@$options) {
    if($option->{'item'} eq 'title' || $option->{'item'} eq 'retitle') {
      &$error(type=>'warning',
	      message=>"Use of deprecated option '".$option->{'item'}."'"
	      .&posinfo($option)) if $option->{'item'} eq 'title';
      my ($range,$title)=$option->{'value'}=~/^(\S+)\s+(.+)$/;
      $titleoverrides{$range}=$title;
    }
  }
  my $insidealbum=0;
  &installhandler('album',$from,sub {
		    if($insidealbum>0) {
		      &$error('type' => 'config',
			      'message'
			      => "The include of album $include in album ".
			         "$from causes a loop.");
		    }
		    $insidealbum=1;
		    my $ret=&listhandlephoto('album',$include);
		    $insidealbum=0;
		    foreach my $item (@$ret) {
		      if($item->{'type'} eq 'group') {
			if(exists $titleoverrides{$item->{'range'}}) {
			  $item->{'description'}
			    =$titleoverrides{$item->{'range'}};
			}
			if(exists $item->{'name'}
			   && exists $titleoverrides{$item->{'name'}}) {

			  $item->{'description'}
			    =$titleoverrides{$item->{'name'}};
			}
		      }
		    }
		    return $ret;
		  });
  &installhandler('rangeinfo',$from,sub {
		    return sub {
		      my ($range)=@_;

		      if($insidealbum>0) {
			&$error('type' => 'config',
				'message' 
				=> "The include of album $include in album ".
				"$from causes a loop.");
		      }
		      $insidealbum=1;
		      my $rangeinfo=
			&parameterhandlephoto('rangeinfo',$include,$range);
		      $insidealbum=0;
		      
		      if(defined $rangeinfo) {
			$rangeinfo->{'description'}=$titleoverrides{$range}
			  if exists $titleoverrides{$range};
			my $name=$rangeinfo->{'name'};
			$rangeinfo->{'description'}=$titleoverrides{$name}
			  if defined $name && exists $titleoverrides{$name};
		      }

		      return $rangeinfo;

		    };
		  });
}

sub enumsubdirs {
  my ($dir,$subpath)=@_;
  my @ret;
  if(&isdir("$dir$subpath")) {
    return if !&checkpath("$dir$subpath");
    push @ret,$subpath;
    my @subdirs=&getfiles("$dir$subpath");
    foreach my $subdir (@subdirs) {
      next if $subdir eq '.' || $subdir eq '..';
      push @ret,&enumsubdirs($dir,"$subpath/$subdir");
    }
  }
  return @ret;
}



1;
