#! c:/perl/bin/perl # # flist2.cgi # # 2.0 : 4/2/05 : Added download button in filelist.cgi # # Need Archive::Zip # # $Id: flist2.cgi,v 1.2 2005/09/25 04:41:34 Hideki Kanayama Exp $ use Archive::Zip; use CGI::Carp fatalsToBrowser; use Cwd; $script="flist2.cgi"; $version = "2.0"; $updatedyear = "2005"; # Directory name to be displayed $dldir = "files"; # Temporary file name and a directory to store it $prefix = 'flist'; $zipfile = "$prefix$$.zip"; $zipdir = cwd(); # Expiration time(minutes) to delete temporary .zip files in the directory of $zipdir $expire = 60; # Title $title = 'filelist'; &error("No directory $dldir") if (! -d $dldir); &error("No directory $zipdir") if (! -d $zipdir); opendir(DLDIR, "$dldir") or &error("Cannot open direcotry $dldir"); @filelist = grep !/^\./, readdir DLDIR; closedir(DLDIR); %in = &parsedata; if ($in{mode} eq 'download'){ &makezip; } else { &display; } exit; sub makezip { my $zip = Archive::Zip->new(); my $member; chdir($dldir); my $i=0; my $eachfile; foreach (keys(%in)){ if ($in{$_} eq 'on'){ next if ($_ eq allon || $_ eq alloff); /check_(\d\d*)/; $eachfile = $filelist[$1]; $member = $zip->addFile("$eachfile"); } } my $status = $zip->writeToFileNamed("$zipfile"); if ($status != AZ_OK) { unlink("$zipfile") if (-e "$zipfile"); &error("Cannot create $zipfile") } rename "$zipfile", "$zipdir/$zipfile"; chdir($zipdir); print "Location: $zipfile\n\n"; } sub display { opendir(ZIPDIR, "$zipdir") or &error("Cannot open directory $zipdir"); @ziplist = grep /^$prefix.*\.zip$/, readdir ZIPDIR; closedir(ZIPDIR); my $zipfile; my $now = time; foreach $zipfile (@ziplist){ ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$zipdir/$zipfile"); if ($now > $d_mtime + $expire * 60){ unlink("$zipdir/$zipfile"); } } print "Content-Type: text/html\n\n"; &beginning; print qq|
\n|; print qq|\n|; print qq|

\n|; print qq|All on\n|; print qq|All off
\n|; my $i; for ($i=0;$i<=$#filelist;$i++){ $dlfile = $filelist[$i]; chomp($dlfile); $dllistfile = "$dldir/$dlfile"; ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$dllistfile"); ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($d_mtime); $update = sprintf("%s/%s/%s %02s:%02s",$mon+1,$mday,$year+1900,$hour,$min); if ($d_size > 1048576){ $size = sprintf("%.1fMB",$d_size/1048576); } elsif ($d_size > 1024){ $size = sprintf("%.1fkB",$d_size/1024); } else { $size = sprintf("%dB",$d_size); } $checkname = "check_$i"; print qq||; print "$dlfile ($size)"; print " .......... $update
\n"; } print qq|

\n|; print "

\n"; &ending; } sub beginning { print ""; print < $title HEADPRINT &jsset; print "\n"; print "\n"; } sub ending { print "
\n"; print qq|
$script Ver. $version
Copyright(c) $updatedyear, Hideki
\n|; print ""; print ""; } sub error { print "Content-Type: text/html\n\n"; &beginning; print "
$_[0]
\n"; &ending; exit; } sub jsset { my (@locallist) = @filelist; print < function allcheck(){ if (document.selectfile.allon.checked==1){ document.selectfile.alloff.checked=0; JSDISP1 my $localfile; my $i=0; foreach $localfile (@locallist){ $check = "check_$i"; print " document.selectfile.$check.checked=1;\n"; $i++; } print " }\n"; print "}\n"; print < JSDISP3 } sub parsedata { if ($ENV{"REQUEST_METHOD"} eq "GET"){ $data=$ENV{"QUERY_STRING"}; $method = 'GET'; } elsif ($ENV{"REQUEST_METHOD"} eq "POST"){ read(STDIN,$data,$ENV{"CONTENT_LENGTH"}); $method = 'POST' } @tmparray=split(/&/,$data); foreach $string (@tmparray){ ($key,$value)=split(/=/,$string); $in{"$key"}=$value; } return(%in); }