source: main/tags/2.61/gsdl/cgi-bin/download@ 25600

Last change on this file since 25600 was 10226, checked in by davidb, 19 years ago

The world is not yet ready for #!perl instead of #!/usr/bin/perl. The
scripts were changed to the latter, intending to be compatible across
Windows and Unix, however while #!perl works for Windows it breaks under
Linux. The header line has been returned to the Unix specific version.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 2.2 KB
Line 
1#!/usr/bin/perl -w
2
3use gsdlCGI;
4
5sub load_gsdl_utils
6{
7 my ($gsdlhome) = @_;
8
9 require "$gsdlhome/perllib/util.pm";
10}
11
12sub main
13{
14 my $gsdl_cgi = new gsdlCGI("+cmdline");
15
16 $gsdl_cgi->setup_gsdl();
17 my $gsdlhome = $ENV{'GSDLHOME'};
18
19 load_gsdl_utils($gsdlhome);
20
21 my $col = $gsdl_cgi->clean_param("c");
22 if (!defined $col) {
23 $gsdl_cgi->generate_error("No collection specified.");
24 }
25
26 my $dir = $gsdl_cgi->clean_param("dir");
27 $dir = "\"\"" if ((!defined $dir) || ($dir eq "."));
28
29 my $accept_expr = $gsdl_cgi->clean_param("a");
30 if(($accept_expr eq "") || (!defined $accept_expr)) {
31 $accept_expr = "";
32 }
33 else {
34 $accept_expr = "-accept " . $accept_expr;
35 }
36
37 my $reject_expr = $gsdl_cgi->clean_param("r");
38 if(($reject_expr eq "") || (!defined $reject_expr)) {
39 $reject_expr = "";
40 }
41 else {
42 $reject_expr = "-reject " . $reject_expr;
43 }
44
45 my $zip_dirname = "";
46
47 if ($col =~ m/^\//) {
48 # leading / at start denotes special "cols" such as "/tmp"
49
50 $zip_dirname = $gsdlhome;
51 $col =~ s/^\///;
52 }
53 else {
54 $zip_dirname = &util::filename_cat($gsdlhome,"collect");
55 }
56
57 my $java = $gsdl_cgi->check_for_java();
58
59 my $classpath
60 = &util::filename_cat($gsdlhome,"bin","java","SignedGatherer.jar");
61 my $java_prog = "org.greenstone.gatherer.util.Zipup";
62 my $java_args = "$zip_dirname $col $dir $accept_expr $reject_expr";
63 my $java_cmd = "$java -classpath $classpath $java_prog $java_args";
64
65 my $java_output = `$java_cmd`;
66
67 my $status = $?;
68
69 if ($status>0) {
70 $status = $status/256;
71 my $exit_status = "Exit status: $status\n";
72 my $mess = "Java failed: $java_cmd\n--\n$java_output\n$exit_status";
73 $gsdl_cgi->generate_error($mess);
74 }
75
76 my $zip_filename = &util::filename_cat($zip_dirname,"$col.zip");
77
78 if (open(PIN,"<$zip_filename")) {
79 binmode(PIN);
80
81 my $buf;
82 my $num_bytes = 0;
83
84 print STDOUT "Content-type:application/zip\n\n";
85
86 while (read(PIN,$buf,1024)>0) {
87 print STDOUT $buf;
88 $num_bytes += length($buf);
89 }
90
91 close(PIN);
92 }
93 else {
94 my $mess = "Unable to read in $zip_filename\n $!";
95 $gsdl_cgi->generate_error($mess);
96 }
97
98 unlink "$zip_filename";
99}
100
101&main();
102
Note: See TracBrowser for help on using the repository browser.