1: #!/usr/bin/perl -w
   2: # Written by Paris Sinclair, aka Aighearach, march 2000
   3: # freed to the public domain
   4: 
   5: use strict;
   6: use CGI qw( :standard :html );
   7: 
   8: # You will need to change these to set up your page
   9: use constant UPLOAD_DIR => '/home/paris/public_html/files/';
  10: use constant RELATIVE_DIR => 'files/';
  11: use constant TITLE => "Lauren's Internet Media Center";
  12: # nothing more to edit
  13: 
  14: my ( $uploaded_file, $url );
  15: 
  16: print header(),
  17:     start_html(), 
  18:     center(),
  19:     h1( TITLE );
  20: 
  21: # is this the index?
  22: if ( param() ) {
  23:     # no, so are we uploading or deleteing?
  24:     if ( my $file = param('delete') ) {
  25: 	# deleting. You may want to add an or print STDERR "can't delete $file\n";
  26: 	# to this I left that out because I don't want the errors in the apache logs - that's
  27: 	# for the mission critical programs, so I just print the error to the page
  28: 	unlink( RELATIVE_DIR.$file ) || print "error unlinking $file";
  29:     } elsif ( my $uploaded_file = param('uploaded_file') ) {
  30: 	# uploading. make it something cool
  31: 	my $full_name = UPLOAD_DIR . $uploaded_file;
  32: 	open ( OUT, ">$full_name") || print "error writing $full_name";
  33: 	my $buffer;
  34: 	while ( read( $uploaded_file, $buffer, 1024 ) ) {
  35: 	    print OUT $buffer;
  36: 	}
  37: 	#Delete('uploaded_file');
  38:     }
  39: }
  40: print 
  41:     table( {-border=>0,-align=>"center"},
  42: 	   file_list() ),
  43:     table( {-border=>0,-align=>"center"},
  44: 	   Tr(
  45: 	      [
  46: 	       td( upload_form() )
  47: 	       ]
  48: 	      )
  49: 	   );
  50: 
  51: ### returns upload form
  52: sub upload_form {
  53:     return start_multipart_form( -action=>url() ) .
  54: 	"upload:" .
  55: 	    filefield(
  56: 		      -name=>'uploaded_file',
  57: 		      -default=>'',
  58: 		      -size=>50,
  59: 		      -maxlength=>100
  60: 		      )
  61: 		.
  62: 		    submit(
  63: 			   -name=>'upload',
  64: 			   -value=>'upload'
  65: 			   )
  66: 			. end_multipart_form();
  67: }
  68: 
  69: ### returns table rows, so make sure you're in a table
  70: sub file_list {
  71:     my $file;
  72:     my $dir = UPLOAD_DIR;
  73:     my $output;
  74:     # it may be better to open the dir by hand, but in the context
  75:     # it was written for, the performance difference is irrelevant
  76:     foreach $file ( `ls $dir` ) {
  77: 	chomp($file);
  78: 	my $full_file = $dir . $file;
  79: 	my $size = (stat("$full_file"))[7];
  80: 	$output .= Tr(
  81: 		      td( 
  82: 			  [
  83: 			   a( {-href=>RELATIVE_DIR.$file},$file ),
  84: 			   # this part could use some work. In particular,
  85: 			   # it should label large files in megs.
  86: 			   int($size/1024) . 'K',
  87: 			   a( {-href=>url()."?delete=$file"}, "delete" )
  88: 			   ]
  89: 			  )
  90: 		      );
  91:     };
  92:     return $output;
  93: }