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