I spent some time over the last few days, incorporating comments I
received on an earlier version of this script, and looking for more code
to steal :). Thanks to everyone who commented.
I now have a version of this script which works the way I would like on
my system: It displays links (with optional thumbnails) to all jpeg files
in a specified location in a table format (where the number of images per
row is determined by the template), along with an optional description of
each photo. Given my inexperience with Perl, I would appreciate comments
on how to improve the script, especially regarding security holes. I
would eventually like to use this script on my personal web pages, and I
would hate to cause trouble for my hosting service.
By the way, I am not sure the included code below is getting too long for
posting here. Should I just post a URL in the future?
=== BEGIN: photobrowser.pl
#!C:/Perl/bin/perl.exe -Tw
# photobrowser
# Display links (optionally with thumbnails and descriptions)
# to images in a directory
$|++;
use strict;
use diagnostics;
use CGI qw(:standard);
use HTML::Template;
use FileHandle;
use Config::Properties;
my $query = CGI::new();
my $location = $query->param("location");
$location = '' if !$location;
# See if location contains any relative paths
bail_out($location, 'Invalid location specified in request.')
if $location =~ /(\.\.)/;
# Configuration Variables
my %config = (
wwwroot => '',
script_location => '/cgi-bin/photobrowser.pl',
htdocs_path => 'C:/Program Files/Apache Group/Apache2/htdocs',
template_path => 'C:/Program Files/Apache Group/Apache2/templates',
template_file => 'photobrowser.tmpl.html',
thumb_dir => 'thumb',
descriptions => 'album',
default_description => '© 2003 A. Sinan Unur',
);
my $photo_path = "$config{htdocs_path}/${location}";
my $template = HTML::Template->new(
filename => "$config{template_path}/$config{template_file}");
# Provide some information during development
$template->param(HTDOCS => $config{htdocs_path});
$template->param(LOCATION => $location);
$template->param(PHOTO_PATH => $photo_path);
$template->param(DESC_FILE => "$photo_path/$config{descriptions}");
# get the list of images
opendir(PHOTO_DIR, $photo_path) || bail_out($photo_path);
my @files = grep { !/^\.+/ && /\.jpe?g$/i } readdir(PHOTO_DIR);
closedir PHOTO_DIR;
# get photo descriptions if possible
my $descriptions = Config::Properties->new();
my $desc_fh = new FileHandle("< $photo_path/$config{descriptions}");
if(defined $desc_fh) {
$descriptions->load($desc_fh);
undef $desc_fh;
}
my $title = $descriptions->getProperty('title');
$template->param(TITLE => ($title ? $title : $location));
# Use the technique described by Chris Davies at
# http://bluedot.net/mail/archive/read.php?f=9&i=2353&t=2345
# to deduce the number of photos to display per row
my $photos_per_row
= scalar grep { /^URL\d+$/i } $template->query (loop => 'PHOTO_LIST');
my @loop_data;
do {
my $counter = 0;
my $iter_data = {};
foreach my $file (@files) {
$iter_data->{'FILE'.($photos_per_row ? $counter : '')} = $file;
$iter_data->{'URL'.($photos_per_row ? $counter : '')}
= "$config{wwwroot}/$location/$file";
$iter_data->{'THUMB'.($photos_per_row ? $counter : '')}
= -e "$photo_path/$config{thumb_dir}/$file"
? "$config{wwwroot}/$location/$config{thumb_dir}/$file" : "";
my $desc = $descriptions->getProperty(lc($file));
$iter_data->{'DESC'.($photos_per_row ? $counter : '')}
= $desc ? $desc : $config{default_description};
$counter = ($counter + 1) % ($photos_per_row || 1);
if(!$counter) {
push(@loop_data, $iter_data);
$iter_data = {};
}
}
push(@loop_data, $iter_data) if scalar keys %$iter_data;
};
$template->param(PHOTO_LIST => \@loop_data);
print header, $template->output;
### SUBROUTINES
sub bail_out {
my $file = shift;
my $message = shift;
print header, $message;
die "$file: $!"; # goes to the webserver log
}
1;
__END__
=== END: photobrowser.pl
=== BEGIN: photobrowser.tmpl.html
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="en">
<head>
<title>Photo Browser - <TMPL_VAR TITLE></title>
</head>
<body>
<!-- provide some info during development -->
<p>HTDOCS: <TMPL_VAR HTDOCS></p>
<p>LOCATION: <TMPL_VAR LOCATION></p>
<p>PHOTO_PATH: <TMPL_VAR PHOTO_PATH></p>
<p>DESCRIPTIONS: <TMPL_VAR DESC_FILE></p>
<h1 align="center"><TMPL_VAR TITLE></h1>
<center>
<TMPL_IF PHOTO_LIST>
<table border="0" bgcolor="#ccccff" cellspacing="1" cellpadding="4">
<TMPL_LOOP PHOTO_LIST>
<tr valign="top">
<td align="center" bgcolor="white" width="140"><!-- PHOTO 0
--><a href="<TMPL_VAR URL0>"><!--
--><TMPL_IF THUMB0><!--
--><img border="0" src="<TMPL_VAR THUMB0>"
alt="<TMPL_IF DESC0><TMPL_VAR DESC0><TMPL_ELSE><TMPL_VAR
FILE0></TMPL_IF>"><!--
--><TMPL_ELSE><TMPL_VAR FILE0></TMPL_IF><!--
--></a>
<br>
<small><TMPL_IF DESC0><TMPL_VAR DESC0><TMPL_ELSE><TMPL_VAR FILE0>
</TMPL_IF></small>
</td>
<td align="center" bgcolor="white" width="140"><!-- PHOTO 1
--><a href="<TMPL_VAR URL1>"><!--
--><TMPL_IF THUMB1><!--
--><img border="0" src="<TMPL_VAR THUMB1>"
alt="<TMPL_IF DESC1><TMPL_VAR DESC1><TMPL_ELSE><TMPL_VAR
FILE1></TMPL_IF>"><!--
--><TMPL_ELSE><TMPL_VAR FILE1></TMPL_IF><!--
--></a>
<br>
<small><TMPL_IF DESC1><TMPL_VAR DESC1><TMPL_ELSE><TMPL_VAR FILE1>
</TMPL_IF></small>
</td>
<td align="center" bgcolor="white" width="140"><!-- PHOTO 2
--><a href="<TMPL_VAR URL2>"><!--
--><TMPL_IF THUMB2><!--
--><img border="0" src="<TMPL_VAR THUMB2>"
alt="<TMPL_IF DESC2><TMPL_VAR DESC2><TMPL_ELSE><TMPL_VAR
FILE2></TMPL_IF>"><!--
--><TMPL_ELSE><TMPL_VAR FILE2></TMPL_IF><!--
--></a>
<br>
<small><TMPL_IF DESC2><TMPL_VAR DESC2><TMPL_ELSE><TMPL_VAR FILE2>
</TMPL_IF></small>
</td>
<td align="center" bgcolor="white" width="140"><!-- PHOTO 3
--><a href="<TMPL_VAR URL3>"><!--
--><TMPL_IF THUMB3><!--
--><img border="0" src="<TMPL_VAR THUMB3>"
alt="<TMPL_IF DESC3><TMPL_VAR DESC3><TMPL_ELSE><TMPL_VAR
FILE3></TMPL_IF>"><!--
--><TMPL_ELSE><TMPL_VAR FILE3></TMPL_IF><!--
--></a>
<br>
<small><TMPL_IF DESC3><TMPL_VAR DESC3><TMPL_ELSE><TMPL_VAR FILE3>
</TMPL_IF></small>
</td>
</tr>
</TMPL_LOOP>
</table>
<TMPL_ELSE>
<p>No images to show</p>
</TMPL_IF>
</center>
</body>
</html>
=== END: photobrowser.tmpl.html
--
A. Sinan Unur
as...@c-o-r-n-e-l-l.edu
Remove dashes for address
Spam bait: mailto:u...@ftc.gov
> I now have a version of this script which works the way I would like on
> my system: It displays links (with optional thumbnails) to all jpeg files
> in a specified location in a table format (where the number of images per
> row is determined by the template), along with an optional description of
> each photo. Given my inexperience with Perl, I would appreciate comments
> on how to improve the script, especially regarding security holes. I
> would eventually like to use this script on my personal web pages, and I
> would hate to cause trouble for my hosting service.
Given your "inexperience", the script is pretty well done. Rather a
pleasant exception for posts like "Comment my script".
> By the way, I am not sure the included code below is getting too long for
> posting here. Should I just post a URL in the future?
Depends on the length of the script. This one isn't too long and by
putting it into the post, the group can comment on it line-by-line
without any prior copying.
>=== BEGIN: photobrowser.pl
>
> #!C:/Perl/bin/perl.exe -Tw
> # photobrowser
> # Display links (optionally with thumbnails and descriptions)
> # to images in a directory
>
> $|++;
> use strict;
> use diagnostics;
That's how any script of this length (and even of shorter length) should
start. Very nice.
> use CGI qw(:standard);
> use HTML::Template;
>
> use FileHandle;
> use Config::Properties;
>
> my $query = CGI::new();
You are calling the constructor as a function, but it really is a
class-method:
my $query = CGI->new;
This should make a difference actually and I wonder that it also worked
the way you did it. Anyway, keep in mind that class methods are not
functions so call them with 'CLASS->method'.
Since you are using the object-oriented interface of CGI, you don't need
to import the ':standard' tag from CGI. I think, an empty import would
have done as well:
use CGI ();
> my $location = $query->param("location");
> $location = '' if !$location;
The above two lines can be squeezed to one:
my $location = $query->param("location") || '';
> # See if location contains any relative paths
> bail_out($location, 'Invalid location specified in request.')
> if $location =~ /(\.\.)/;
>
> # Configuration Variables
> my %config = (
> wwwroot => '',
> script_location => '/cgi-bin/photobrowser.pl',
> htdocs_path => 'C:/Program Files/Apache Group/Apache2/htdocs',
> template_path => 'C:/Program Files/Apache Group/Apache2/templates',
> template_file => 'photobrowser.tmpl.html',
> thumb_dir => 'thumb',
> descriptions => 'album',
> default_description => '© 2003 A. Sinan Unur',
> );
>
> my $photo_path = "$config{htdocs_path}/${location}";
^ ^
Not wrong, but I'd have written that as
my $photo_path = "$config{htdocs_path}/$location";
The curlies aren't needed in the above case. But you can leave them in
if you find that it makes the string concatenation clearer.
> my $template = HTML::Template->new(
> filename => "$config{template_path}/$config{template_file}");
>
> # Provide some information during development
> $template->param(HTDOCS => $config{htdocs_path});
> $template->param(LOCATION => $location);
> $template->param(PHOTO_PATH => $photo_path);
> $template->param(DESC_FILE => "$photo_path/$config{descriptions}");
>
> # get the list of images
> opendir(PHOTO_DIR, $photo_path) || bail_out($photo_path);
> my @files = grep { !/^\.+/ && /\.jpe?g$/i } readdir(PHOTO_DIR);
> closedir PHOTO_DIR;
You are using @files later in the do-block, but nowhere else. You should
therefore move the above three lines into this block to further restrict
the scope of @files. Thus you keep the top-level block clean and
uncluttered with variables.
> # get photo descriptions if possible
> my $descriptions = Config::Properties->new();
> my $desc_fh = new FileHandle("< $photo_path/$config{descriptions}");
> if(defined $desc_fh) {
> $descriptions->load($desc_fh);
> undef $desc_fh;
I found this line confusing. The intent is to close the file-handle.
According to the docs of FileHandle undeffing it is the same as using
the close() method:
$desc_fh->close;
looks more natural and doesn't keep the reader wondering what undef()
does in this context.
> }
>
> my $title = $descriptions->getProperty('title');
> $template->param(TITLE => ($title ? $title : $location));
Simpler:
$template->param( TITLE => $title || $location );
> # Use the technique described by Chris Davies at
> # http://bluedot.net/mail/archive/read.php?f=9&i=2353&t=2345
> # to deduce the number of photos to display per row
>
> my $photos_per_row
> = scalar grep { /^URL\d+$/i } $template->query (loop => 'PHOTO_LIST');
You can even drop the scalar() here, although it does no harm.
> my @loop_data;
> do {
> my $counter = 0;
> my $iter_data = {};
> foreach my $file (@files) {
I would change the foreach to a while-loop:
opendir PHOTO_DIR, $photo_path) || bail_out($photo_path);
while (<PHOTODIR>) {
# directory entry now in $_
next if /^\.+/ || ! /^.jpe?g$/i;
Possibly you want to skip over subdirectories instead of things matching
'/^\.+/'. If so:
next if -d "$photo_path/$_" || ! /^.jpe?g$/i;
# or perhaps only regular files
next if ! (-f "$photo_path/$_" && /^.jpe?g$/i);
> $iter_data->{'FILE'.($photos_per_row ? $counter : '')} = $file;
> $iter_data->{'URL'.($photos_per_row ? $counter : '')}
> = "$config{wwwroot}/$location/$file";
> $iter_data->{'THUMB'.($photos_per_row ? $counter : '')}
> = -e "$photo_path/$config{thumb_dir}/$file"
> ? "$config{wwwroot}/$location/$config{thumb_dir}/$file" : "";
Hmmh, you have this '($photos_per_row ? $counter : '')' three times.
Perhaps a temporary variable to store this expression is better:
my $prefix = $photos_per_row ? $counter : '';
$iter_data->{"FILE$prefix"} = $file;
$iter_data->{"URL$prefix"} = "$config{wwwroot}/$location/$file";
$iter_data->{"THUMB$prefix" = ...;
Change $file to $_ each time in the above, if you plan using the
while-loop.
> my $desc = $descriptions->getProperty(lc($file));
> $iter_data->{'DESC'.($photos_per_row ? $counter : '')}
> = $desc ? $desc : $config{default_description};
> $counter = ($counter + 1) % ($photos_per_row || 1);
> if(!$counter) {
> push(@loop_data, $iter_data);
> $iter_data = {};
> }
> }
> push(@loop_data, $iter_data) if scalar keys %$iter_data;
I have some problems with the logic of the last six lines. Currently it
looks like:
do {
my $iter_data;
foreach (...) {
...
if (! $counter) {
push @loop_data, $iter_data;
$iter_data = { };
}
}
push @loop_data, $iter_data if keys %$iter_data;
}
It has something to do with the amount of photos that can be stored in
one row. It might be better to change the structure of @loop_data and
$iter_data to make the intent of the above clearer. @loop_data should be
a two-dimensional array, like a table, and $iter_data should become
$picture or so:
# second picture in first row
$loop_data[0][1] = $picture;
Right now you have (simplified):
@loop_data = (
{ FILE1 => ..., URL1 => ...,
FILE2 => ..., URL2 => ...,
... },
{ FILE1 => ..., URL1 => ...,
FILE2 => ..., URL2 => ...,
... },
...
);
where
@loop_data = (
# first row
[ { FILE => ..., URL => ..., ...},
{ FILE => ..., URL => ..., ...},
... ],
# second row
[ { FILE => ..., URL => ..., ...},
{ FILE => ..., URL => ..., ...},
... ],
...
);
would be easier to handle. You make quite some contortions to give the
several entries in the hash unique prefixes to distinguish later which
"URL"-key belongs to which "FILE"-key.
So it's a matter of a more suitable data-structure really.
> };
> $template->param(PHOTO_LIST => \@loop_data);
>
> print header, $template->output;
You are mixing the object-oriented interface of CGI.pm with the
functional one. Not wrong, but a little inconsistent IMHO.
print $query->header, $template->output;
[...]
Anyway, it's mostly the odd choice of data-structure that needs some
attention. The other complains are more of a cosmetical nature.
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
> I spent some time over the last few days, incorporating comments I
> received on an earlier version of this script, and looking for more code
> to steal :).
^^^^^^^^
The correct term is "to reuse". :-)
> # See if location contains any relative paths
The comment does not match what the code actually does.
It doesn't check for *any* relative paths, only those that
might go "higher" in the dir tree.
./me.jpg and family_reunion/sis.jpg
are relative paths that your code does not check for.
> bail_out($location, 'Invalid location specified in request.')
> if $location =~ /(\.\.)/;
^ ^
^ ^ a useless use of parens
Absolute paths can be bad too, but you don't check for them.
if $location =~ /\.\./ or $location =~ m#^/#;
You should probably have an explicit chdir() somewhere near
the top of your program too.
> my $photo_path = "$config{htdocs_path}/${location}";
^ ^
^ ^
A useless use of curlies.
> sub bail_out {
> my $file = shift;
> my $message = shift;
my($file, $message) = @_;
Makes it easier to add a 3rd argument...
--
Tad McClellan SGML consulting
ta...@augustmail.com Perl programming
Fort Worth, Texas
>> By the way, I am not sure the included code below is getting too long for
>> posting here. Should I just post a URL in the future?
>
> Depends on the length of the script. This one isn't too long and by
> putting it into the post, the group can comment on it line-by-line
> without any prior copying.
But we don't really need to see all (or any) of the HTML template.
> my $location = $query->param("location");
> $location = '' if !$location;
What if $location eq '0' ?
Do you want to overwrite it with the empty string?
Probably not, so:
$location = '' unless defined $location;
> Also sprach A. Sinan Unur:
...
>> I would appreciate comments on how to improve the script,
...
> Given your "inexperience", the script is pretty well done. Rather a
> pleasant exception for posts like "Comment my script".
Thank you.
>> my $query = CGI::new();
>
> You are calling the constructor as a function, but it really is a
> class-method:
>
> my $query = CGI->new;
>
> This should make a difference actually and I wonder that it also
> worked the way you did it. Anyway, keep in mind that class methods are
> not functions so call them with 'CLASS->method'.
Thank you for catching that. I didn't get any warnings, so I would probably
never have noticed it.
...
(I didn't want to lengthen my post by repeating all your other comments,
but I should note that I understand them, and see how they improve the
quality of the script. Thanks.)
>
>> my $desc = $descriptions->getProperty(lc($file));
>> $iter_data->{'DESC'.($photos_per_row ? $counter : '')}
>> = $desc ? $desc : $config{default_description};
>> $counter = ($counter + 1) % ($photos_per_row || 1);
>> if(!$counter) {
>> push(@loop_data, $iter_data);
>> $iter_data = {};
>> }
>> }
>> push(@loop_data, $iter_data) if scalar keys %$iter_data;
>
> I have some problems with the logic of the last six lines. Currently
> it looks like:
>
> do {
> my $iter_data;
> foreach (...) {
> ...
> if (! $counter) {
> push @loop_data, $iter_data;
> $iter_data = { };
> }
> }
> push @loop_data, $iter_data if keys %$iter_data;
> }
>
> It has something to do with the amount of photos that can be stored in
> one row.
yes, the last push is for 'left-over' photos. So, if I had 50 photos in the
directory, and $photos_per_row was 4, I would have two left over in
iter_data when at the end of the loop. So, I make sure to push them as
well.
> It might be better to change the structure of @loop_data and
> $iter_data to make the intent of the above clearer. @loop_data should
> be a two-dimensional array, like a table, and $iter_data should become
> $picture or so:
I understand that. However, my purpose was to find a way to have a single
loop in the template for displaying the links to the photos, as well as
finding a way to have the number of photos be determined by the template.
Given the way parameters are passed to the template, I couldn't figure out
how work the mechanics with a multi-dimensional array. But I'll try again,
taking your suggestions into account.
> would be easier to handle. You make quite some contortions to give the
> several entries in the hash unique prefixes to distinguish later which
> "URL"-key belongs to which "FILE"-key.
See above.
>> print header, $template->output;
>
> You are mixing the object-oriented interface of CGI.pm with the
> functional one. Not wrong, but a little inconsistent IMHO.
That's where my inexperience shines :)
Thank you.
Sinan.
> A. Sinan Unur <as...@c-o-r-n-e-l-l.edu> wrote:
>
>> I spent some time over the last few days, incorporating comments I
>> received on an earlier version of this script, and looking for more
>> code to steal :).
> ^^^^^^^^
> The correct term is "to reuse". :-)
>
>
>> # See if location contains any relative paths
>
> The comment does not match what the code actually does.
Correct. Thanks.
> It doesn't check for *any* relative paths, only those that
> might go "higher" in the dir tree.
>
> ./me.jpg and family_reunion/sis.jpg
I figured the first is not material for this script because I prepend the
absolute path $htdocs. I actually want the second type of request to be
permissable, so I can use the script to navigate subcategories. The
specific usage I intend should be documented, however.
> Absolute paths can be bad too, but you don't check for them.
>
> if $location =~ /\.\./ or $location =~ m#^/#;
Right, however, I thought prepending the absolute path to htdocs (I
should actually change the name of that parameter to something like
album_path) to location took care of the possibility of browsing to
unallowed locations.
> You should probably have an explicit chdir() somewhere near
> the top of your program too.
Good idea. That would probably simplify the later logic.
>> sub bail_out {
>> my $file = shift;
>> my $message = shift;
>
>
> my($file, $message) = @_;
>
> Makes it easier to add a 3rd argument...
Cool.
Thank you for all your comments.
Sinan.
This won't work because the directory handle name is spelled incorrectly
and, more importantly, <> doesn't work on directory handles, just file
handles.
while ( definded( $_ = readdir PHOTO_DIR ) ) {
> # directory entry now in $_
> next if /^\.+/ || ! /^.jpe?g$/i;
John
--
use Perl;
program
fulfillment
He "steals".
You "reuse".
I "enhance the value of" .
:)
> "Tassilo v. Parseval" wrote:
>> opendir PHOTO_DIR, $photo_path) || bail_out($photo_path);
>> while (<PHOTODIR>) {
>
> This won't work because the directory handle name is spelled incorrectly
> and, more importantly, <> doesn't work on directory handles, just file
> handles.
>
> while ( definded( $_ = readdir PHOTO_DIR ) ) {
Oh, right on both. I try this '<DIR_HANDLE>' trick often in my scripts
just to realize that it's still an un-feature. I guess I'll never quite
get rid of this mistake in cognition.
Is that wise under mod_perl? (or if you want to port to mod_perl later)
->malte
I think it is going to be better for me to stick with absolute paths
rather than changing to the photos directory. If my understanding is
correct, the latter might indeed cause problems further down the road
with mod_perl.
Thanks.
Sinan.
PS: By the way, the first version of the script can be seen in action at
http://www.unur.com/cgi-bin/photobrowser?location=sinan/usa_02_
03/places&template=cols3
Thanks to everyone who commented.