upload.pl

GROK print_form() unless param; print_results() if param; print br,br; saverss(); #print `/www/bin/rss2html.pl /www/XML/rss/kwark.incoming.rss`; &lsfiles; print <
pip\@dds.nl changed upload.pl from Cute Tricks with Perl and Apache. GROK print end_html; } #------------------------------------------- sub print_form { print <

GROK # print start_multipart_form(), # filefield(-name=>'upload',-size=>60),br, # filefield(-name=>'upload', # -value=>'/fire/tmp/moz.html'), # br, # submit(-label=>'Upload File'), # end_form; } sub print_results { my $length; my $file = param('upload'); my $mime= uploadInfo($file)->{'Content-Type'}||"unknown" if $file; my $content; if (!$file) { print "No filename, try again.
\n"; &print_form; return; } print p('File name: ', $file); print p('File MIME type: ',$mime); while (<$file>) { my $i=$_; $length += length($i); $content .= $i; } if (!$length){ print "Zere length file uploaded,try again.
\n"; &print_form; return; } print p('File length: ',$length); print &savefile($file,$content); } sub savefile{ my ($file,$content)=@_; print "Saving $file\n"; $file="/www/incoming/".$file; while ( -r $file){ my ($d)=$file =~ m!\.(\d+)$!; $file =~ s/\.$d$//; $d++; $file .= ".$d"; print "
file already exists, trying $file\n"; } open (FILE, ">$file") || return "Can't open $file" ; print FILE $content; close(FILE); return " done.
\n"; } sub saverss{ my $dir = "/www/incoming"; open(FILE,">/www/XML/rss/kwark.incoming.rss"); my $c=rssls($dir); print FILE $c; close FILE; } sub rssls{ my ($dir)=@_; my ($limit)=param('rss'); my ($li); $limit=15 unless $limit; my @ls=`ls -l1t $dir`; chop(@ls); splice(@ls, $limit) if ($limit); foreach my $i (@ls){ $li .= < $i http://$dyndns/incoming/$i GROK } unless($li){ $li= < No files, click to upload. http://$dyndns/x/upload.pl GROK } return < Kwark incoming http://$dyndns/x/upload.pl 15 latest imcoming en-us $li GROK } sub lsfiles{ my $dir="/www/incoming/"; my @ls=`ls -l1t $dir`; chop(@ls); my $li='

$i GROK } $li.="

\n"; print <

Listing of $dir

$li GROK }