Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Quick-n-dirty Photo Album

by newrisedesigns (Curate)
on Feb 14, 2003 at 18:44 UTC ( #235367=sourcecode: print w/ replies, xml ) Need Help??

Category: CGI Programming
Author/Contact Info John J Reiser
www.newrisedesigns.com
comments encouraged: /msg me or reply
Description: An online photo album that's easy to set up and use. Nothing elaborate, just a simple way to display the images (JPGs) in a directory on your website. Feel free to download, use, and modify as you see fit.
#!/usr/bin/perl -w

## Quick and Dirty Online Photo Album
##  by John J Reiser (newrisedesigns)

use strict;
use CGI;
use HTML::Template;

my $cgi        = "/cgi-bin/album.pl";    #CGI Location
my $url        = "/photoalbum/";            #IMG SRC - needs trailing 
+slash
my $server    = 'http://www.website.tld';    #Server - NO trailing sla
+sh
my $root    = "../../httpdocs/photoalbum/";        #Filesystem - needs
+ trailing slash
my $template    = "template.html";            #file (in photo director
+y)

my $q = CGI->new();
my $t = HTML::Template->new(filename => $root . $template);

my $album = $q->param('album') || '';
if($album =~ /(\w+)/){
    $album = $1;
}
else{
    $album = '';
}


if($album eq ''){

my @dir = finddir($root);

my $form;

$form = $q->start_form(-method=>"POST");
$form .= $q->p($q->popup_menu(-name=>"album", -value=>[@dir]));
$form .= $q->p($q->submit());
$form .= $q->end_form;

$t->param(DIR => "Choose an album to view");
$t->param(RLINK => $form);

print $q->header();
print $t->output();


}
else{

my $rlink = q[<a href="] . $cgi . q[?">click here to view a different 
+album</a>];
my $dlink = $server . $cgi . '?album=' . $album;

$album    .= '/';
$url    .= $album;

$t->param(DIR => $album);
$t->param(SHOWLINK => 1);
$t->param(RLINK => $rlink);
$t->param(DLINK => $dlink);

my $fh;

opendir($fh, $root . $album) or die("Cannot open $root$album $!");
my @files = sort grep(/\.jpg$/, readdir($fh));
closedir($fh);

my @tags;

foreach(@files){
    my $tag = q[<img src="] . $url . $_ . q[" alt="" border="0">];
    push(@tags, {'TAG' => $tag});
}

$t->param(PICTURES => \@tags);

print $q->header();
print $t->output();

}

sub finddir{

my $dir = shift;
my $fh;

chdir($dir);

opendir($fh, '.');
my @files = sort grep((-d $_) && ($_ !~ /\./), readdir($fh));
closedir($fh);

return @files;

}
__END__

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http:/
+/www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html>
<head>
<title>photo album</title>
<style>
<!-- 
.small { font-size: .75em; }
-->
</style>
</head>

<body bgcolor="#FFFFFF">
<h1><TMPL_VAR NAME="DIR"></h1>
<TMPL_IF NAME="SHOWLINK">
    <p class="small">Link directly to this album:<br /><TMPL_VAR NAME=
+"DLINK"></p>
</TMPL_IF>
    <div align="center" class="small"><TMPL_VAR NAME="RLINK"></div>
    <TMPL_LOOP NAME="PICTURES">
        <p align="center"><TMPL_VAR NAME="TAG"></p> 
    </TMPL_LOOP>
</body>
</html>

Comment on Quick-n-dirty Photo Album
Download Code
Re: Quick-n-dirty Photo Album
by PodMaster (Abbot) on Feb 15, 2003 at 17:24 UTC
    Here's a suggestion, use File::Spec
    perl -MFile::Spec -e " die File::Spec->catfile( qw[ foo /bar baz ], sh +ift ) " bar

    update: and use URI::URL; ;)

    perl -MURI::URL -e " die URI::URL->new(q[foo/bar/baz], q[http://bar.co +m/])->canonical; " perl -MURI::URL -e " die URI::URL->new(q[foo/bar/baz], q[http://bar.co +m/])->abs; "

    update: Also, it's nice that you used HTML::Template, but you might consider a lighter weight alternative to CGI (CGI::Simple) since you're not using CGI to generate x?html.


    MJD says you can't just make shit up and expect the computer to know what you mean, retardo!
    I run a Win32 PPM repository for perl 5.6x+5.8x. I take requests.
    ** The Third rule of perl club is a statement of fact: pod is sexy.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://235367]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (10)
As of 2014-10-23 20:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (129 votes), past polls