#! c:/perl/bin/perl
#
# phdisp.cgi
#
# 1.001 : 6/11/06 : Delete CGI.pm
# 1.0 : 6/10/06 : Created
#
# $Id: phdisp.cgi,v 1.1 2006/06/18 04:55:34 Hideki Kanayama Exp $
# Copyright(c) 2006 Hideki Kanayama, all rights reserved
#
# Use a SSI as follows.
#
#
# Display images in $imagedir randomly.
#
#
use strict;
use CGI::Carp qw(fatalsToBrowser);
# image directory
# A relative path from the CGI or absolute path
my $imagedir_from_cgi = "../image";
# A relative path from the shtml file or absolute path
my $imagedir_from_shtml = "image";
my $version = "1.001";
my $lastupdatedyear = "2006";
my $script = "phdisp.cgi";
my $lang = 1;
my $charset = "ISO-8859-1";
if (! -d "$imagedir_from_cgi") {
&error("No $imagedir_from_cgi directory.");
}
&display;
exit;
sub display {
my $imagefile;
my @newlist;
opendir(IMGDIR,"$imagedir_from_cgi") or &error("Cannot open directory $imagedir_from_cgi.");
my @filelist = grep !/^\./, readdir IMGDIR;
closedir(IMGDIR);
@newlist = ( grep /\.jpe?g$/i, @filelist);
@newlist = (@newlist, grep /\.gif$/i, @filelist);
@newlist = (@newlist, grep /\.png$/i, @filelist);
@newlist = (@newlist, grep /\.bmp$/i, @filelist);
@newlist = (@newlist, grep /\.tiff?$/i, @filelist);
@newlist = (@newlist, grep /\.ief$/i, @filelist);
@newlist = (@newlist, grep /\.cgm$/i, @filelist);
@newlist = (@newlist, grep /\.pcx$/i, @filelist);
&error("No image files in $imagedir_from_shtml.") if ($#newlist == -1);
$imagefile = $newlist[rand($#newlist+1)];
&error("No image files in $imagedir_from_shtml.") if (! -e "$imagedir_from_cgi/$imagefile");
print "Content-Type: text/html\n\n";
print "![](\"$imagedir_from_shtml/$imagefile\")
\n";
}
sub error {
my ($msg) = shift;
&htmlhead($msg);
print "
$msg\n";
print "
";
©right;
print "
";
&htmltail;
exit;
}
sub htmlhead {
my $title = shift;
my $bgimage = "bgcolor=\"white\"";
print "Content-Type: text/html\n\n";
print "\n";
print "\n";
print "\n";
print "$title\n";
print "\n";
print "\n";
}
sub copyright {
my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
print "phdisp.cgi Ver. $version
\n";
print "Copyright(C) $lastupdatedyear, hidekik.com\n";
}
sub htmltail {
print "\n";
exit;
}