[tgal] / mason / .perl-lib / TrivGal.pm

### -*-cperl-*-
###
### Main output for Trivial Gallery.
###
### (c) 2021 Mark Wooding
###

###----- Licensing notice ---------------------------------------------------
###
### This file is part of Trivial Gallery.
###
### Trivial Gallery is free software: you can redistribute it and/or modify
### it under the terms of the GNU Affero General Public License as
### published by the Free Software Foundation; either version 3 of the
### License, or (at your option) any later version.
###
### Trivial Gallery is distributed in the hope that it will be useful, but
### WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
### Affero General Public License for more details.
###
### You should have received a copy of the GNU Affero General Public
### License along with Trivial Gallery.  If not, see
### <https://www.gnu.org/licenses/>.

package TrivGal;

use autodie qw{:all};

use Errno;
use Exporter qw{import};
use File::stat;
use Image::ExifTool qw{};
use Image::Imlib2;
use User::pwent;
use POSIX;

our @EXPORT;
sub export (@) { push @EXPORT, @_; }

###--------------------------------------------------------------------------
### Internal utilities.

sub read_or_set ($\$@) {
  my ($me, $ref, @args) = @_;
  if (@args == 0) { return $$ref; }
  elsif (@args == 1) { $$ref = $args[0]; return $me; }
  elsif (@args > 1) { die "too many arguments"; }
}

###--------------------------------------------------------------------------
### Random utilities.

export qw{join_paths};
sub join_paths (@) {
  my @p = @_;
  my $p = "";
  ELT: for my $e (@p) {
    $e =~ s#^/{2,}#/#;
    $e =~ s#([^/])/+$#$1#;
    if ($e eq "") { next ELT; }
    elsif ($p eq "" || $e =~ m#^/#) { $p = $e; }
    else { $p = "$p/$e"; }
  }
  return $p;
}

export qw{split_path};
sub split_path ($) {
  my ($path) = @_;

  my ($dir, $base, $ext) =
    $path =~ m#^ (?: (.*) /)?
		 (?: ([^/]*) \.)?
		 ([^./]*) $#x;
  if (defined $base) { $ext = ".$ext"; }
  else { $base = $ext; $ext = ""; }
  return ($dir, $base, $ext);
}

export qw{urlencode};
sub urlencode ($) {
  my ($u) = @_;
  $u =~ s#([^0-9a-zA-Z_./~-])#sprintf "%%%02x", ord $1#eg;
  return $u;
}

export qw{urldecode};
sub urldecode ($) {
  my ($u) = @_;
  $u =~ s#\%([0-9a-fA-F]{2})#chr hex $1#eg;
  return $u;
}

###--------------------------------------------------------------------------
### Image types.

our %TYPE;

package TrivGal::ImageType {
  sub new ($$) {
    my ($cls, $ext) = @_;
    return $TYPE{$ext} = bless { ext => $ext }, $cls;
  }
  sub ext ($) {
    my ($me, @args) = @_;
    return $me->{ext};
  }
  sub mimetype ($@) {
    my ($me, @args) = @_;
    return TrivGal::read_or_set $me, $me->{mimetype}, @args;
  }
  sub imlibfmt ($@) {
    my ($me, @args) = @_;
    return TrivGal::read_or_set $me, $me->{imlibfmt}, @args;
  }
}

TrivGal::ImageType->new(".jpg")->mimetype("image/jpeg")->imlibfmt("jpeg");
TrivGal::ImageType->new(".png")->mimetype("image/png")->imlibfmt("png");

###--------------------------------------------------------------------------
### Configuration.

export qw{$SCOPE $SUFFIX};
our $SCOPE //= $::SCOPE;
our $SUFFIX //= $::SUFFIX;

export qw{$IMGROOT $CACHE $TMP};
our $IMGROOT //= "$ENV{HOME}/publish/$SCOPE-html$SUFFIX/tgal-images";
our $CACHE //=
  ($ENV{XDG_CACHE_HOME} // "$ENV{HOME}/.cache") .
  "/tgal/$SCOPE$SUFFIX";
our $TMP //= "$CACHE/tmp";

export qw{$ROOTURL $IMGURL $CACHEURL $STATICURL $SCRIPTURL};
my $user = getpwuid($>)->name;
our $ROOTURL //= "/~$user";
our $IMGURL //= "$ROOTURL/tgal-images";
our $CACHEURL //= "$ROOTURL/tgal-cache";
our $STATICURL //= "$ROOTURL/tgal-static";
our $SCRIPTURL;

export qw{$SRCURL};
our $SRCURL = "https://git.distorted.org.uk/~mdw/tgal/";

export qw{%SIZE};
our %SIZE = (smallthumb => 96,
	     medthumb => 144,
	     bigthumb => 228,
	     small => 480,
	     embed => 720,
	     view => 1200);

export qw{init};
my $initp = 0;
sub init () {
  my $m = HTML::Mason::Request->instance;
  my $r = $m->cgi_request;

  $m->interp->set_escape(u => sub { my ($r) = @_; $$r = urlencode $$r; });

  return unless !$initp;

  $SCRIPTURL //= $r->subprocess_env("SCRIPT_NAME");
  $initp = 1;
}

###--------------------------------------------------------------------------
### Temporary files.

export qw{clean_temp_files};
sub clean_temp_files () {
  my $d;

  eval { opendir $d, $TMP; };
  if ($@) {
    if ($@->isa("autodie::exception") && $@->errno == ENOENT) { return; }
    else { die $@; }
  }
  my $now = time;
  FILE: while (my $name = readdir $d) {
    next FILE unless $name =~ /^t(\d+)\-/;
    my $pid = $1;
    next FILE if kill 0, $pid;
    my $f = "$TMP/$name";
    my $st = stat $name;
    next FILE if $now - $st->mtime() < 300;
    unlink $f;
  }
  closedir $d;
}

###--------------------------------------------------------------------------
### Scaled images.

my %ORIENT =
  (1 => [0, 0],
   2 => [0, 1],
   3 => [2, 0],
   4 => [2, 1],
   5 => [3, 1],
   6 => [1, 0],
   7 => [1, 1],
   8 => [3, 0]);

package TrivGal::Image {
  use File::Path qw{make_path};
  use File::stat;

  sub new ($$) {
    my ($cls, $path) = @_;
    my $imgpath = "$IMGROOT/$path";
    my $st = stat $imgpath or die "no image `$path'";
    return bless {
      path => $path,
      mtime => $st->mtime,
      img => undef
    }, $cls;
  }

  sub scale ($$;$) {
    my ($me, $scale, $forcep) = @_;
    my $m = HTML::Mason::Request->instance;

    my $path = $me->{path};
    my $sz = $SIZE{$scale} or die "unknown scale `$scale'";
    my $thumb = "$CACHE/scale.$sz/$path";
    my $thumburl =
      $m->interp->apply_escapes("$CACHEURL/scale.$sz/$path", "u");
    my $st = stat $thumb;
    if (defined $st && $st->mtime > $me->{mtime}) { return $thumburl; }
    return
      $m->interp->apply_escapes("$SCRIPTURL/$path", "u") . "?scale=$scale"
      unless $forcep;

    my ($dir, $base, $ext) = TrivGal::split_path $thumb;
    my $ty = $TYPE{lc $ext} or die "unknown type `$ext'";

    my $img = $me->{img};
    unless (defined $img) {
      my $imgpath = "$IMGROOT/$path";
      my $exif = new Image::ExifTool;
      $exif->ExtractInfo($imgpath);
      my $orient = $exif->GetValue("Orientation", "ValueConv");
      $img = $me->{img} = Image::Imlib2->load($imgpath);
      if (defined $orient) {
	my ($rot, $flip) = @{$ORIENT{$orient}};
	if ($rot) { $img->image_orientate($rot); }
	if ($flip) { $img->flip_horizontal(); }
      }
    }

    my ($wd, $ht) = ($img->width, $img->height);
    my $max = $wd > $ht ? $wd : $ht;
    if ($max <= $sz) { return "$IMGURL/$path"; }
    my $sc = $sz/$max;
    my $scaled = $img->create_scaled_image($sc*$wd, $sc*$ht);

    $scaled->image_set_format($ty->imlibfmt);
    $scaled->set_quality(90);
    my $new = "$TMP/t$$-$ext";
    make_path $TMP, { mode => 0771 };
    $scaled->save($new);
    make_path $dir, { mode => 0771 };
    rename $new, $thumb;
    return $thumburl;
  }
}

###--------------------------------------------------------------------------
### Directory listings.

package TrivGal::Item {
  sub new ($$) {
    my ($cls, $name) = @_;
    return bless { name => $name }, $cls;
  }
  sub name ($@) {
    my ($me, @args) = @_;
    return TrivGal::read_or_set $me, $me->{name}, @args;
  }
  sub comment ($@) {
    my ($me, @args) = @_;
    return TrivGal::read_or_set $me, $me->{comment}, @args;
  }
}

export qw{listdir};
sub listdir ($) {
  my ($path) = @_;
  my (@d, @f);
  my $ix = undef;

  $path =~ s#/$##;
  if (-f "$path/.tgal.index") {
    open my $f, "<", "$path/.tgal.index";
    my $item = undef;
    my $comment = undef;
    LINE: while (<$f>) {
      chomp;
      next LINE if /^\s*(\#|$)/;
      if (s/^\s+//) {
	die "no item" unless $item;
	$comment = defined $comment ? $comment . "\n" . $_ : $_;
      } else {
	if ($item && $comment) { $item->comment($comment); }
	my ($flags, $name, $c) =
	  /^ (?: ([-!]+) \s+)?		# flags
	     (\S+) \s*			# filename
	     (\S | \S.*\S )?		# start of the comment
	     \s*
	     $/x;
	my $indexp = $flags =~ /!/;
	my $hidep = $flags =~ /-/;
	$name = urldecode $name;
	my $list;
	$item = TrivGal::Item->new($name);
	if ($name =~ m#/$#) {
	  $list = \@d;
	  die "can't index a folder" if $indexp;
	} else {
	  $list = \@f;
	  my ($dir, $base, $ext) = split_path $name;
	  die "unknown image type" unless $TYPE{lc $ext};
	  if ($indexp) {
	    die "two index images" if defined $ix;
	    $ix = $item;
	  }
	}
	$comment = $c;
	push @$list, $item unless $hidep;
      }
    }
    if ($item && $comment) { $item->comment($comment); }
    close $f;
  } else {
    my $st = stat $path;
    unless ($st->mode&0004) { return ([], [], undef); }

    opendir $d, $path;
    my @e = readdir $d;
    closedir $d;

    ENT: for my $e (sort @e) {
      my ($dir, $base, $ext) = split_path $e;
      my $dotp = $e =~ /^\./;
      my $st = stat "$path/$e";
      my $list = undef;
      if ($dotp) { }
      elsif (-d $st) { $list = \@d; $e .= "/"; }
      elsif ($TYPE{lc $ext} && -f $st) { $list = \@f; }
      $list and push @$list, TrivGal::Item->new($e);
    }
    $ix = $f[0] if @f;
  }

  return (\@d, \@f, $ix);
}

export qw{contents};
sub contents ($) {
  my ($file) = @_;
  my $contents = "";
  my $f;
  local $@;
  eval { open $f, "<", "$file"; };
  if ($@) {
    if ($@->isa("autodie::exception") && $@->errno == ENOENT)
      { return undef; }
    die $@;
  }
  while (sysread $f, $buf, 16384) { $contents .= $buf; }
  close $f;
  return $contents;
}

export qw{find_covering_file};
sub find_covering_file ($$$) {
  my ($top, $path, $name) = @_;
  for (;;) {
    my $stuff = contents "$top/$path/$name"; return $stuff if defined $stuff;
    if ($path eq "") { return undef; }
    if ($path =~ m#^(.*)/[^/]+/?#) { $path = $1; }
    else { $path = ""; }
  }
}

###----- That's all, folks --------------------------------------------------

clean_temp_files;

1;
Commit	Line	Data
6ac5dde2 MW	1	### --cperl--
	2	###
	3	### Main output for Trivial Gallery.
	4	###
	5	### (c) 2021 Mark Wooding
	6	###
	7
	8	###----- Licensing notice ---------------------------------------------------
	9	###
	10	### This file is part of Trivial Gallery.
	11	###
	12	### Trivial Gallery is free software: you can redistribute it and/or modify
	13	### it under the terms of the GNU Affero General Public License as
	14	### published by the Free Software Foundation; either version 3 of the
	15	### License, or (at your option) any later version.
	16	###
	17	### Trivial Gallery is distributed in the hope that it will be useful, but
	18	### WITHOUT ANY WARRANTY; without even the implied warranty of
	19	### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	20	### Affero General Public License for more details.
	21	###
	22	### You should have received a copy of the GNU Affero General Public
	23	### License along with Trivial Gallery. If not, see
	24	### <https://www.gnu.org/licenses/>.
	25
	26	package TrivGal;
	27
	28	use autodie qw{:all};
	29
	30	use Errno;
	31	use Exporter qw{import};
6ac5dde2	32	use File::stat;
bda837fc	33	use Image::ExifTool qw{};
6ac5dde2 MW	34	use Image::Imlib2;
	35	use User::pwent;
	36	use POSIX;
	37
	38	our @EXPORT;
	39	sub export (@) { push @EXPORT, @_; }
	40
	41	###--------------------------------------------------------------------------
	42	### Internal utilities.
	43
	44	sub read_or_set ($\$@) {
	45	my ($me, $ref, @args) = @_;
	46	if (@args == 0) { return $$ref; }
	47	elsif (@args == 1) { $$ref = $args[0]; return $me; }
	48	elsif (@args > 1) { die "too many arguments"; }
	49	}
	50
	51	###--------------------------------------------------------------------------
	52	### Random utilities.
	53
	54	export qw{join_paths};
	55	sub join_paths (@) {
	56	my @p = @_;
	57	my $p = "";
	58	ELT: for my $e (@p) {
e9eac06d MW	59	$e =~ s#^/{2,}#/#;
e9eac06d MW	60	$e =~ s#([^/])/+$#$1#;
6ac5dde2	61	if ($e eq "") { next ELT; }
e9eac06d	62	elsif ($p eq "" \|\| $e =~ m#^/#) { $p = $e; }
6ac5dde2 MW	63	else { $p = "$p/$e"; }
	64	}
	65	return $p;
	66	}
	67
	68	export qw{split_path};
	69	sub split_path ($) {
	70	my ($path) = @_;
	71
9fc5e8c1 MW	72	my ($dir, $base, $ext) =
	73	$path =~ m#^ (?: (.*) /)?
	74	(?: ([^/]*) \.)?
	75	([^./]*) $#x;
6ac5dde2 MW	76	if (defined $base) { $ext = ".$ext"; }
	77	else { $base = $ext; $ext = ""; }
	78	return ($dir, $base, $ext);
	79	}
	80
	81	export qw{urlencode};
	82	sub urlencode ($) {
	83	my ($u) = @_;
e9eac06d	84	$u =~ s#([^0-9a-zA-Z_./~-])#sprintf "%%%02x", ord $1#eg;
6ac5dde2 MW	85	return $u;
	86	}
	87
	88	export qw{urldecode};
	89	sub urldecode ($) {
	90	my ($u) = @_;
e9eac06d	91	$u =~ s#\%([0-9a-fA-F]{2})#chr hex $1#eg;
6ac5dde2 MW	92	return $u;
	93	}
	94
	95	###--------------------------------------------------------------------------
	96	### Image types.
	97
	98	our %TYPE;
	99
	100	package TrivGal::ImageType {
	101	sub new ($$) {
	102	my ($cls, $ext) = @_;
	103	return $TYPE{$ext} = bless { ext => $ext }, $cls;
	104	}
	105	sub ext ($) {
	106	my ($me, @args) = @_;
	107	return $me->{ext};
	108	}
	109	sub mimetype ($@) {
	110	my ($me, @args) = @_;
	111	return TrivGal::read_or_set $me, $me->{mimetype}, @args;
	112	}
	113	sub imlibfmt ($@) {
	114	my ($me, @args) = @_;
	115	return TrivGal::read_or_set $me, $me->{imlibfmt}, @args;
	116	}
65e4ebfd	117	}
6ac5dde2 MW	118
	119	TrivGal::ImageType->new(".jpg")->mimetype("image/jpeg")->imlibfmt("jpeg");
	120	TrivGal::ImageType->new(".png")->mimetype("image/png")->imlibfmt("png");
	121
	122	###--------------------------------------------------------------------------
	123	### Configuration.
	124
	125	export qw{$SCOPE $SUFFIX};
	126	our $SCOPE //= $::SCOPE;
	127	our $SUFFIX //= $::SUFFIX;
	128
	129	export qw{$IMGROOT $CACHE $TMP};
	130	our $IMGROOT //= "$ENV{HOME}/publish/$SCOPE-html$SUFFIX/tgal-images";
	131	our $CACHE //=
	132	($ENV{XDG_CACHE_HOME} // "$ENV{HOME}/.cache") .
	133	"/tgal/$SCOPE$SUFFIX";
	134	our $TMP //= "$CACHE/tmp";
	135
	136	export qw{$ROOTURL $IMGURL $CACHEURL $STATICURL $SCRIPTURL};
	137	my $user = getpwuid($>)->name;
	138	our $ROOTURL //= "/~$user";
	139	our $IMGURL //= "$ROOTURL/tgal-images";
	140	our $CACHEURL //= "$ROOTURL/tgal-cache";
	141	our $STATICURL //= "$ROOTURL/tgal-static";
	142	our $SCRIPTURL;
	143
a38a867d MW	144	export qw{$SRCURL};
	145	our $SRCURL = "https://git.distorted.org.uk/~mdw/tgal/";
	146
6ac5dde2	147	export qw{%SIZE};
1408b7a2 MW	148	our %SIZE = (smallthumb => 96,
	149	medthumb => 144,
	150	bigthumb => 228,
40c686c2 MW	151	small => 480,
40c686c2 MW	152	embed => 720,
1408b7a2	153	view => 1200);
6ac5dde2 MW	154
	155	export qw{init};
	156	my $initp = 0;
	157	sub init () {
	158	my $m = HTML::Mason::Request->instance;
	159	my $r = $m->cgi_request;
	160
	161	$m->interp->set_escape(u => sub { my ($r) = @_; $$r = urlencode $$r; });
	162
	163	return unless !$initp;
	164
	165	$SCRIPTURL //= $r->subprocess_env("SCRIPT_NAME");
	166	$initp = 1;
	167	}
	168
	169	###--------------------------------------------------------------------------
	170	### Temporary files.
	171
	172	export qw{clean_temp_files};
	173	sub clean_temp_files () {
	174	my $d;
	175
	176	eval { opendir $d, $TMP; };
	177	if ($@) {
	178	if ($@->isa("autodie::exception") && $@->errno == ENOENT) { return; }
	179	else { die $@; }
	180	}
	181	my $now = time;
	182	FILE: while (my $name = readdir $d) {
	183	next FILE unless $name =~ /^t(\d+)\-/;
	184	my $pid = $1;
	185	next FILE if kill 0, $pid;
	186	my $f = "$TMP/$name";
	187	my $st = stat $name;
	188	next FILE if $now - $st->mtime() < 300;
	189	unlink $f;
	190	}
	191	closedir $d;
	192	}
	193
	194	###--------------------------------------------------------------------------
	195	### Scaled images.
	196
bda837fc MW	197	my %ORIENT =
	198	(1 => [0, 0],
	199	2 => [0, 1],
	200	3 => [2, 0],
	201	4 => [2, 1],
	202	5 => [3, 1],
	203	6 => [1, 0],
	204	7 => [1, 1],
	205	8 => [3, 0]);
	206
4e74ddf4 MW	207	package TrivGal::Image {
	208	use File::Path qw{make_path};
	209	use File::stat;
	210
	211	sub new ($$) {
	212	my ($cls, $path) = @_;
	213	my $imgpath = "$IMGROOT/$path";
	214	my $st = stat $imgpath or die "no image `$path'";
	215	return bless {
	216	path => $path,
	217	mtime => $st->mtime,
	218	img => undef
	219	}, $cls;
	220	}
	221
784bdf8f MW	222	sub scale ($$;$) {
784bdf8f MW	223	my ($me, $scale, $forcep) = @_;
1b3d6791	224	my $m = HTML::Mason::Request->instance;
4e74ddf4 MW	225
	226	my $path = $me->{path};
	227	my $sz = $SIZE{$scale} or die "unknown scale `$scale'";
	228	my $thumb = "$CACHE/scale.$sz/$path";
1b3d6791 MW	229	my $thumburl =
1b3d6791 MW	230	$m->interp->apply_escapes("$CACHEURL/scale.$sz/$path", "u");
4e74ddf4 MW	231	my $st = stat $thumb;
4e74ddf4 MW	232	if (defined $st && $st->mtime > $me->{mtime}) { return $thumburl; }
784bdf8f MW	233	return
	234	$m->interp->apply_escapes("$SCRIPTURL/$path", "u") . "?scale=$scale"
	235	unless $forcep;
4e74ddf4 MW	236
	237	my ($dir, $base, $ext) = TrivGal::split_path $thumb;
	238	my $ty = $TYPE{lc $ext} or die "unknown type `$ext'";
	239
	240	my $img = $me->{img};
	241	unless (defined $img) {
	242	my $imgpath = "$IMGROOT/$path";
bda837fc MW	243	my $exif = new Image::ExifTool;
	244	$exif->ExtractInfo($imgpath);
	245	my $orient = $exif->GetValue("Orientation", "ValueConv");
4e74ddf4	246	$img = $me->{img} = Image::Imlib2->load($imgpath);
bda837fc MW	247	if (defined $orient) {
	248	my ($rot, $flip) = @{$ORIENT{$orient}};
	249	if ($rot) { $img->image_orientate($rot); }
f6158607	250	if ($flip) { $img->flip_horizontal(); }
bda837fc	251	}
4e74ddf4 MW	252	}
	253
	254	my ($wd, $ht) = ($img->width, $img->height);
	255	my $max = $wd > $ht ? $wd : $ht;
	256	if ($max <= $sz) { return "$IMGURL/$path"; }
	257	my $sc = $sz/$max;
	258	my $scaled = $img->create_scaled_image($sc$wd, $sc$ht);
	259
	260	$scaled->image_set_format($ty->imlibfmt);
	261	$scaled->set_quality(90);
227d23a0	262	my $new = "$TMP/t$$-$ext";
2306963b	263	make_path $TMP, { mode => 0771 };
4e74ddf4	264	$scaled->save($new);
2306963b	265	make_path $dir, { mode => 0771 };
4e74ddf4 MW	266	rename $new, $thumb;
	267	return $thumburl;
	268	}
6ac5dde2 MW	269	}
	270
	271	###--------------------------------------------------------------------------
	272	### Directory listings.
	273
	274	package TrivGal::Item {
	275	sub new ($$) {
	276	my ($cls, $name) = @_;
	277	return bless { name => $name }, $cls;
	278	}
	279	sub name ($@) {
	280	my ($me, @args) = @_;
	281	return TrivGal::read_or_set $me, $me->{name}, @args;
	282	}
	283	sub comment ($@) {
	284	my ($me, @args) = @_;
	285	return TrivGal::read_or_set $me, $me->{comment}, @args;
	286	}
65e4ebfd	287	}
6ac5dde2 MW	288
	289	export qw{listdir};
	290	sub listdir ($) {
	291	my ($path) = @_;
	292	my (@d, @f);
	293	my $ix = undef;
	294
24f4eac3	295	$path =~ s#/$##;
6ac5dde2 MW	296	if (-f "$path/.tgal.index") {
	297	open my $f, "<", "$path/.tgal.index";
	298	my $item = undef;
	299	my $comment = undef;
	300	LINE: while (<$f>) {
	301	chomp;
	302	next LINE if /^\s*(\#\|$)/;
	303	if (s/^\s+//) {
	304	die "no item" unless $item;
	305	$comment = defined $comment ? $comment . "\n" . $_ : $_;
	306	} else {
	307	if ($item && $comment) { $item->comment($comment); }
9940cc5a	308	my ($flags, $name, $c) =
6e51720c	309	/^ (?: ([-!]+) \s+)? # flags
9fc5e8c1 MW	310	(\S+) \s* # filename
	311	(\S \| \S.*\S )? # start of the comment
	312	\s*
	313	$/x;
9940cc5a	314	my $indexp = $flags =~ /!/;
6e51720c	315	my $hidep = $flags =~ /-/;
6ac5dde2 MW	316	$name = urldecode $name;
6ac5dde2 MW	317	my $list;
0485371e	318	$item = TrivGal::Item->new($name);
e9eac06d	319	if ($name =~ m#/$#) {
6ac5dde2 MW	320	$list = \@d;
	321	die "can't index a folder" if $indexp;
	322	} else {
	323	$list = \@f;
b39b2681	324	my ($dir, $base, $ext) = split_path $name;
6ac5dde2 MW	325	die "unknown image type" unless $TYPE{lc $ext};
	326	if ($indexp) {
	327	die "two index images" if defined $ix;
	328	$ix = $item;
	329	}
	330	}
6ac5dde2	331	$comment = $c;
6e51720c	332	push @$list, $item unless $hidep;
6ac5dde2 MW	333	}
	334	}
	335	if ($item && $comment) { $item->comment($comment); }
	336	close $f;
	337	} else {
ebe19115	338	my $st = stat $path;
32fc7001 MW	339	unless ($st->mode&0004) { return ([], [], undef); }
32fc7001 MW	340
6ac5dde2 MW	341	opendir $d, $path;
	342	my @e = readdir $d;
	343	closedir $d;
	344
	345	ENT: for my $e (sort @e) {
	346	my ($dir, $base, $ext) = split_path $e;
	347	my $dotp = $e =~ /^\./;
	348	my $st = stat "$path/$e";
	349	my $list = undef;
32fc7001	350	if ($dotp) { }
24f4eac3	351	elsif (-d $st) { $list = \@d; $e .= "/"; }
6ac5dde2 MW	352	elsif ($TYPE{lc $ext} && -f $st) { $list = \@f; }
	353	$list and push @$list, TrivGal::Item->new($e);
	354	}
	355	$ix = $f[0] if @f;
	356	}
	357
	358	return (\@d, \@f, $ix);
	359	}
	360
	361	export qw{contents};
	362	sub contents ($) {
	363	my ($file) = @_;
	364	my $contents = "";
	365	my $f;
	366	local $@;
	367	eval { open $f, "<", "$file"; };
	368	if ($@) {
	369	if ($@->isa("autodie::exception") && $@->errno == ENOENT)
	370	{ return undef; }
	371	die $@;
	372	}
	373	while (sysread $f, $buf, 16384) { $contents .= $buf; }
	374	close $f;
	375	return $contents;
	376	}
	377
	378	export qw{find_covering_file};
	379	sub find_covering_file ($$$) {
	380	my ($top, $path, $name) = @_;
	381	for (;;) {
	382	my $stuff = contents "$top/$path/$name"; return $stuff if defined $stuff;
	383	if ($path eq "") { return undef; }
e9eac06d	384	if ($path =~ m#^(.*)/[^/]+/?#) { $path = $1; }
6ac5dde2 MW	385	else { $path = ""; }
	386	}
	387	}
	388
	389	###----- That's all, folks --------------------------------------------------
	390
	391	clean_temp_files;
	392
	393	1;