package PhotoPub::Utils;
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(&slurp &doifcount &mkpath &remdups &uri_escape
		$pathre $rangere &untaint %errorstrings &checkpath &md5_uri
		&handleparameters &includetag &excludetag &handlepages
                $searchstringre &handletagoptions &parselocalrange &parserange
		&makerightpathstring $namere &photodatestr
		&makeabsolutepath &getdefault &getlinkroot
		&getparallellimit);

use strict;
use PhotoPub::Global qw(&register_init $error);
use PhotoPub::FileInfo qw(&isregfile &isdir &existsfile);
use PhotoPub::Handlers qw(&handlephoto &listhandlephoto);

use Carp;
use URI::Escape 3.20 ();
use Digest::MD5 qw(&md5_base64);
use HTML::Entities;
use POSIX qw(&strftime);

use vars qw($namere $pathre $rangere $searchstringre %errorstrings);

$namere='[\-\_\w\.]+';
$pathre='[\/\-\_\w\.\#\%\ ]+';
$rangere='[\/\-\_\w\,\*]+';
$searchstringre='[\d\w\_\-\s]*';

%errorstrings=('userinput' => 'Parameter error',
	       'config' => 'Configuration error',
	       'internal' => 'Internal error',
	       'picture' => 'Problem with picture',
	       'warning' => 'Warning',
	       'unknown' => 'Error');

sub uri_escape {
  my $text=shift;
  # The list of safe characters is the same as used by default, with the
  # addition of '/' and ','. Although the RFC technically mandates escaping 
  # them, there seems no real reason to and it makes the links look horrible.
  return &URI::Escape::uri_escape($text,q{^A-Za-z0-9\,\-/_.!~*'()});
}

sub md5_uri {
  my $text=shift;
  my $md5=&md5_base64($text);
  $md5=~s{/}{-};
  $md5=~s{\+}{_};
  return $md5;
}  

sub remdups {
  my %ret=();
  foreach (@_) {
    $ret{$_}=1;
  }
  return [keys %ret];
}

sub untaint {
  my ($var,$re,$msg)=@_;
  if($$var=~/^($re)$/) {
    $$var=$1;
    return 1;
  } else {
    &$error('type' => 'userinput', 'message' => $msg)
      if defined $msg;
    return 0;
  }
}

sub slurp {
  my ($filename)=@_;
  if(!open FILE,"<$filename") { 
    &carp("Couldn't open $filename");
    return undef;
  }
  my $data="";
  while(<FILE>) {
    $data.=$_;
  }
  close FILE;

  return $data;
}

sub mkpath {
  my ($basepath,$subpath)=@_;
  my @subdirs=split('/',$subpath);
  foreach my $subdir (@subdirs) {
    next if $subdir eq '';
    $basepath.="/$subdir";
    if(!-d $basepath) {
    #untaint, should really make sure this happens on input
      my ($path)=($basepath=~/^($pathre)$/)
        or &$error(type=>'internal',
                   message=>"Attempt to make invalid directory $basepath"); 
      umask 002;
      mkdir $path,04775
	or &$error(type=>'config',
		   message=>"Couldn't make directory $path");
    }
  }
}

sub doifcount {
  my ($text,$count,$total)=@_;
  my ($pre,$params,$repeat,$post);
  my $ret="";  
   
  while(($pre,$params,$repeat,$post)=($text=~/^(.*?)\<IFCOUNT(.*?)\>(.*?)\<\/IFCOUNT\>(.*)$/si)) {
    $ret.=$pre;
    if($params=~/^\s+MOD\s*(\d+)\s*\=\s*(\-?\d+)\s*$/i) {
      $ret.=$repeat if $count%$1==$2%$1;
    } elsif($params=~/^\s*\=\s*(\d+)\s*$/) {
      $ret.=$repeat if $count==$1;
    } elsif($params=~/^\s*\=\s*\-(\d+)\s*$/) {
      $ret.=$repeat if $count==$total+1-$1;
    } else { 
      &$error("couldn't parse IFCOUNT parameters");
    }
    $text=$post;
  }
  $ret.=$text;
  return $ret;
}

my %checkedcache;

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

sub checkpath {
  my $file = shift;

  return 0 unless &existsfile($file);
# Doing the more careful check is quite a slowdown
#  return 0 if !&isregfile($file) && !&isdir($file);

  my $curpath=$file;

  while(1) {
    ($curpath) = ($curpath=~ /^(.+)\//) or return 1;
    next if exists $checkedcache{$curpath};
    return 0 if $curpath =~ /\/\.\.(?:\/|$)/;
    if (-l $curpath) {
      my ($uid,$gid,$luid,$lgid);
      (undef,undef,undef,undef,$uid,$gid) = stat $curpath;
      return 0 if (!defined $uid);
      (undef,undef,undef,undef,$luid,$lgid) = lstat $curpath;
      return 0 if ($uid != $luid or $gid != $lgid);
    }
    $checkedcache{$curpath}=1;
  }
}

sub handleparameters {
  my ($options,$templateref)=@_;
  my @params=();

  # Handle parameters declared in template file
  while($$templateref=~s/\<PARAMETER (\w+)(.*?)\>//i) {
    my $name=lc($1);
    my $extra=$2;
    my $val=$options->{$name};
    if(defined $val) {
      push @params,$name;
    } else {
      if($extra=~/DEFAULT=(.*)/i) {
	$val=$1;
      } else {
	&$error(type => 'userinput',
		message => "Must specify $name parameter for this template");
      }
    }
    $$templateref=~s/\$$name\b/&encode_entities($val)/ieg;
    $$templateref=~s/\$\{$name\}/&encode_entities($val)/ieg;
  }
  return @params;
}

sub includetag {
  my ($tag,$textref,$count)=@_;
  $count=1 if !defined $count;
  $$textref=~s{<$tag>(.*?)</$tag>}{$1x$count}sieg;
}

sub excludetag {
  &includetag(@_,0);
}

sub handlepages {
  my ($options,$templateref,$startnumref,
      $endnumref,$haveprevornext,$geturl)=@_;

  my ($isprev,$isnext)=(0,0);
  my $page=1;
  my $max;
  my $lastpage=1;
  my $totalnum=$$endnumref+1;

  if($$templateref=~/\<MAXITEMS (\w+)\>/i) {
    $max=$1;
    if($max!~/none/i) {
      $page=exists $options->{'page'} ? $options->{'page'} : 1;
      untaint(\$page,'\d+',"page must be a positive integer");
      my $startnum=($page-1)*$max;
      my $endnum=$page*$max-1;
      if($startnum<=$$startnumref) {
	$isprev=0;
      } else {
	$isprev=1;
	$$startnumref=$startnum;
      }
      # nice easy way of doing integer division...
      my $tempendnum=$$endnumref;
      while ($tempendnum>0) { $tempendnum-=$max; $lastpage++; }
      if($endnum>=$$endnumref) {
	$isnext=0;
      } else {
	$isnext=1;
	$$endnumref=$endnum;
      }
    }
  }
  $$templateref=~s/\<MAXITEMS \w+\>//ig;
  $$templateref=~s/\$page/$page/g;
  $$templateref=~s/\$startnum/($$startnumref+1)/eg;
  $$templateref=~s/\$endnum/($$endnumref+1)/eg;
  $$templateref=~s/\$totalnum/$totalnum/g;
 
  if($isprev || $isnext) {
    &$haveprevornext();
    &includetag('ifpages',$templateref);
    &excludetag('nopages',$templateref);
  } else {
    &excludetag('ifpages',$templateref);
    &includetag('nopages',$templateref);
  }

  if($isnext) {
    &includetag('ifnext',$templateref);
    # $page was untainted to only contain numbers earlier
    my $url=&$geturl($page+1);
    $$templateref=~s{<a(.*?)next(.*?)>}{<a $1 href=\"$url\" $2>}sig;
    $$templateref=~s{\$nexturl}{$url}sig;
    &excludetag('elsenext',$templateref);
  } else {
    &includetag('elsenext',$templateref);
    &excludetag('ifnext',$templateref);
  }

  if($isprev) {
    &includetag('ifprev',$templateref);
    # $page was untainted to only contain numbers earlier
    my $url=&$geturl($page-1);
    $$templateref=~s{<a(.*?)prev(.*?)>}{<a $1 href=\"$url\" $2>}sig;
    $$templateref=~s{\$prevurl}{$url}sig;
    &excludetag('elseprev',$templateref);
  } else {
    &includetag('elseprev',$templateref);
    &excludetag('ifprev',$templateref);
  }
  my $url=&$geturl(1);
  $$templateref=~s{<a(.*?)first(.*?)>}{<a $1 href=\"$url\" $2>}sig;
  $$templateref=~s{\$firsturl}{$url}sig;

  $url=&$geturl($lastpage);
  $$templateref=~s{<a(.*?)last(.*?)>}{<a $1 href=\"$url\" $2>}sig;
  $$templateref=~s{\$lasturl}{$url}sig;


}


sub handletagoptions {
  my ($string,$styleroot,$params)=@_;
  while($params) {
    $params=~s/^\s*//;
    last unless 
      $params=~s/^(\w+)\=\"([^\"]*?)\"// || $params=~s/^(\w+)\=(\S+)//;
    my ($attr,$value)=($1,$2);
    if(lc($attr) eq 'style') {
      $value="$styleroot/$value"  unless substr($value,0,1) eq '/';
    }
    $$string.='&amp;'.$attr.'='.$value;
  }
}

sub parselocalrange {
  my ($rangestr, $rangephoto) = @_;
  foreach (split(/,/,$rangestr)) {
    if(/^(\d+)\-(\d+)$/) {
      foreach my $num ($1..$2) {
	return unless &$rangephoto($num);
      }
    } elsif(/^(\d+)$/) {
      return unless &$rangephoto($1);
    }
  }
}

sub parserange {
  my ($rangestr,$defaultpath,$rangephoto)=@_;
  my $count=0;
  my $curpath=$defaultpath;
  foreach (split(/,/,$rangestr)) {
    if(/^((?:.*\/)?)(\d+)\-(\d+)$/) {
      my $path=$1;
      $path=$curpath.$path if substr($path,0,1) ne '/' && defined $curpath;
      foreach my $num ($2..$3) {
	&$error(type=>'userinput',
		message=>"Range $rangestr has too many possible entries!")
	  if ($count++)>10000;
	return unless &$rangephoto($path,$num);
      }
      $curpath=$path;
    } elsif(/^((?:.*\/)?)(\d+)$/) {
      my $path=$1;
      $path=$curpath.$path if substr($path,0,1) ne '/' && defined $curpath;
      return unless &$rangephoto($path,$2);
      $curpath=$path;
    } elsif(/^((?:.*\/)?)\*$/) {
      my $path=$1;
      $path=$curpath.$path if substr($path,0,1) ne '/' && defined $curpath;
      foreach my $num (sort { $a <=> $b } 
		       @{listhandlephoto('photolist',$path)}) {
	return unless &$rangephoto($path,$num);
      }
      $curpath=$path;
    }
  }
}

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

sub makeabsolutepath {
  my ($name)=@_;
  if(substr($$name,0,1) ne '/') {
    $$name=&getdefault('path').$$name;
  }
}

sub getdefault {
  my ($thing)=@_;
  return &handlephoto('default',"/$thing");
}

my %defaultlinkroots=(
		      'album' => 'album.pl',
		      'range' => 'range.pl',
		      'embed' => 'embed.pl',
		      'page' => 'page.pl',
		      'display' => 'display.pl'
		     );

sub getlinkroot {
  my ($thing)=@_;
  my $root=&handlephoto('linkroot',"/$thing");
  $root=$defaultlinkroots{$thing} unless defined $root;
  return $root;
}

sub getparallellimit {
  my ($thing)=@_;
  my $root=&handlephoto('parallellimit',"/$thing");
  return $root;
}

sub photodatestr {
  my ($photo,$options)=@_;
  my $whentaken=&handlephoto('whentaken',$photo);
  return '' unless defined $whentaken;
  my $format="%c";
  foreach my $attrpair ($options=~m/\w+\=\".*?\"/g) {
    if(my ($attr,$value) = split (/=/, $attrpair)) {
      if(lc($attr) eq 'format') {
        $value=~s/\"(.*)\"/$1/;
        $format=$value;
      }
    }
  }
  return &strftime($format,gmtime($whentaken));
}

1;
