source: trunk/gsdl/cgi-bin/gsdlCGI.pm@ 10583

Last change on this file since 10583 was 10583, checked in by mdewsnip, 19 years ago

Moved the second half of the gsdlCGI.pm new() code out into a new function (parse_cgi_args) to make things a little easier for the West Yorkshire stuff.

  • Property svn:keywords set to Author Date Id Revision
File size: 5.2 KB
Line 
1
2package gsdlCGI;
3
4use CGI;
5use Cwd;
6
7@ISA = ('CGI');
8
9sub new {
10 my $class = shift @_;
11 my ($mode) = @_;
12
13 my $self;
14 if ((defined $mode) && ($mode eq "+cmdline")) {
15 my $line = <STDIN>;
16 if ((defined $line) && ($line ne "")) {
17 $self = new CGI($line);
18 }
19 else {
20 $self = new CGI();
21 }
22 }
23 else {
24 $self = new CGI();
25 }
26
27 return bless $self, $class;
28}
29
30
31sub parse_cgi_args
32{
33 my $self = shift @_;
34 my $xml = (defined $self->param("xml")) ? 1 : 0;
35
36 $self->{'xml'} = $xml;
37
38 my @var_names = $self->param;
39 my @arg_list = ();
40 foreach my $n ( @var_names ) {
41 my $arg = "$n=";
42 my $val = $self->param($n);
43 $arg .= $val if (defined $val);
44 push(@arg_list,$arg);
45 }
46
47 $self->{'args'} = join("&",@arg_list);
48}
49
50
51sub clean_param
52{
53 my $self = shift @_;
54 my ($param) = @_;
55
56 my $val = $self->SUPER::param($param);
57 $val =~ s/[\r\n]+$// if (defined $val);
58
59 return $val;
60}
61
62sub safe_val
63{
64 my $self = shift @_;
65 my ($val) = @_;
66
67 # ensure only alpha-numeric plus a few other special chars remain
68
69 $val =~ s/[^[:alnum:]@\.\/\- :_]//g if (defined $val);
70
71 return $val;
72}
73
74
75sub generate_error
76{
77 my $self = shift @_;
78 my ($mess) = @_;
79
80 my $xml = $self->{'xml'};
81
82 my $full_mess;
83 my $args = $self->{'args'};
84
85 if ($xml) {
86 $full_mess = "<Error>\n";
87 $full_mess .= " $mess\n";
88 $full_mess .= " CGI args were: $args\n";
89 $full_mess .= "</Error>\n";
90 }
91 else {
92 $full_mess = "ERROR: $mess\n ($args)\n";
93 }
94
95 print STDOUT "Content-type:text/plain\n\n";
96 print STDOUT $full_mess;
97
98 die $full_mess;
99}
100
101sub generate_warning
102{
103 my $self = shift @_;
104 my ($mess) = @_;
105
106 my $xml = $self->{'xml'};
107
108 my $full_mess;
109 my $args = $self->{'args'};
110
111 if ($xml) {
112 $full_mess = "<Warning>\n";
113 $full_mess .= " $mess\n";
114 $full_mess .= " CGI args were: $args\n";
115 $full_mess .= "</Warning>\n";
116 }
117 else {
118 $full_mess = "Warning: $mess ($args)\n";
119 }
120
121 print STDOUT "Content-type:text/plain\n\n";
122 print STDOUT $full_mess;
123
124 print STDERR $full_mess;
125}
126
127
128sub generate_ok_message
129{
130 my $self = shift @_;
131 my ($mess) = @_;
132
133 my $xml = $self->{'xml'};
134
135 my $full_mess;
136
137 if ($xml) {
138 $full_mess = "<Accepted>\n";
139 $full_mess .= " $mess\n";
140 $full_mess .= "</Accepted>\n";
141 }
142 else {
143 $full_mess = "$mess\n";
144 }
145
146 print STDOUT "Content-type:text/plain\n\n";
147 print STDOUT $full_mess;
148}
149
150
151
152sub get_config_info {
153 my $self = shift @_;
154 my ($infotype) = @_;
155
156 my $site_filename = "gsdlsite.cfg";
157 open (FILEIN, "<$site_filename")
158 || $self->generate_error("Could not open gsdlsite.cfg");
159
160 my $config_content = "";
161 while(defined (my $line = <FILEIN>)) {
162 $config_content .= $line;
163 }
164 close(FILEIN);
165
166 my ($loc) = ($config_content =~ m/^$infotype\s+((\".+\")|(\S+))\s*\n/m);
167 $loc =~ s/\"//g;
168
169 if ((!defined $loc) || ($loc =~ m/^\s*$/)) {
170 $self->generate_error("$infotype is not set in gsdlsite.cfg");
171 }
172
173 return $loc;
174}
175
176
177sub get_gsdl_home {
178 my $self = shift @_;
179
180 if (defined $self->{'gsdlhome'}) {
181 return $self->{'gsdlhome'};
182 }
183
184 my $gsdlhome = $self->get_config_info("gsdlhome");
185
186 require "$gsdlhome/perllib/util.pm";
187
188 $gsdlhome =~ s/(\/|\\)$//; # remove trailing slash
189
190 $self->{'gsdlhome'} = $gsdlhome;
191
192 return $gsdlhome;
193}
194
195sub get_gsdl_os {
196 my $self = shift @_;
197
198 my $os = $^O;
199
200 if ($os =~ m/linux/i) {
201 return "linux";
202 }
203 elsif ($os =~ /mswin/i) {
204 return "windows";
205 }
206 elsif ($os =~ /macos/i) {
207 return "darwin";
208 }
209 else {
210 # return as is.
211 return $os;
212 }
213}
214
215sub setup_gsdl {
216 my $self = shift @_;
217
218 my $gsdlhome = $self->get_gsdl_home();
219 my $gsdlos = $self->get_gsdl_os();
220
221 $ENV{'GSDLHOME'} = $gsdlhome;
222 $ENV{'GSDLOS'} = $gsdlos;
223
224 my $gsdl_bin_script = &util::filename_cat($gsdlhome,"bin","script");
225 &util::envvar_append("PATH",$gsdl_bin_script);
226
227 my $gsdl_bin_os = &util::filename_cat($gsdlhome,"bin",$gsdlos);
228 &util::envvar_append("PATH",$gsdl_bin_os);
229}
230
231
232sub local_rm_r
233{
234 my $self = shift @_;
235 my ($local_dir) = @_;
236
237 my $prefix_dir = getcwd();
238
239 if ($prefix_dir !~ m/collect/) {
240 $self->generate_error("Trying to delete outside of Greenstone collect: $full_dir");
241 }
242
243 my $full_dir = &util::filename_cat($prefix_dir,$local_dir);
244
245 # Delete recursively
246 if (!-e $full_dir) {
247 $self->generate_error("File/Directory does not exist: $full_dir");
248 }
249
250 &util::rm_r($full_dir);
251}
252
253
254
255sub check_for_java()
256{
257 my $self = shift @_;
258
259 my $java = "java";
260
261 if (defined $ENV{'JAVA_HOME'}) {
262 my $java_home = $ENV{'JAVA_HOME'};
263 # Unix specific
264 $java_home =~ s/\/$//; # remove trailing slash if present
265
266 $java = &util::filename_cat($java_home,"bin","java");
267 }
268 else {
269 my $path = $ENV{'PATH'};
270 my $mess = "JAVA_HOME environment variable not set. Might not be able to find java unless in PATH=$path";
271
272 $self->generate_warning($mess);
273 }
274
275 return $java;
276}
277
278
279sub checked_chdir
280{
281 my $self = shift @_;
282 my ($dir) = @_;
283
284 if (!-e $dir) {
285 $self->generate_error("Directory '$dir' does not exist");
286 }
287
288 chdir $dir
289 || $self->generate_error("Unable to change to directory: $dir");
290}
291
2921;
293
Note: See TracBrowser for help on using the repository browser.