Like this article? We recommend
Like this article? We recommend
Like this article? We recommend
Like this article? We recommend
Listing
01: #!/usr/bin/perl -wT
02: use strict;
03: use CGI qw(:standard);
04: use Archive::Tar;
05: use File::Basename;
06: my @DIRS = qw{tars /tmp};
07: my $SCRIPT = basename $0;
08: my $tar;
09: my %actions = ('list_archives' => \&list_archives,
'' => \&list_archives,
'show_file' => \&show_file,
'show_content' => \&show_content,
);
10: print header;
11: my $action = param('action');
12: if (param('tar')) {
13: $tar = param('tar');
14: $tar =~ s!\.\.?/!!g;
15: }
16: if (exists $actions{$action}) {
17: $actions{$action}->();
18: }else{
19: print qq{Sorry, '$action' isn't supported.<br>};
20: }
21: sub list_archives {
22: print h2("List of files");
23: for my $dir (@DIRS) {
24: print qq{Directory: $dir<br>\n};
25: opendir(DIR, $dir) or print qq{$!<p>\n} and next;
26: my @files = grep {/\.tar(?:\.gz)?$/} readdir(DIR);
27: for (@files) {
28: (my $short_name = $_) =~ s/\.tar.*$//;
29: print a({-href=>"tar.cgi?action=show_file&tar=$d
ir/$_"},$short_name), br;
30: }
31: closedir DIR;
32: print p;
33: }
34: }
35: sub show_file {
36: print h2("Contents of $tar:");
37: print qq{Sorry, '$tar' does not exist.} and return unless -e $tar;
38: my @files = Archive::Tar->list_archive($tar);
39: for (@files) {
40: if (/\/$/) {
41: print qq{$_<br>\n};
42: }else{
43: print '<dd>', a({-href => "tar.cgi?action=show
_content&file=$_&tar=$tar"}, $_), '</dd>';
44: }
45: }
46: }
47: sub show_content {
48: my $file = param('file');
49: my $tar_obj = Archive::Tar->new($tar);
50: print qq{<pre> } . $tar_obj->get_content($file) . qq{</pre>};
51: }
52: print p, a({-href=>$SCRIPT},"Home");
__END__
Kevin Meltzer <perlguy@perlguy.com> is a co-author of Writing CGI Applications with Perl (Addison-Wesley, 2001), web content admin for Yet Another Society, and a Software Engineer for Verio. He has been programming with Perl since 1994.
< Back
Page 3 of 3