source: main/trunk/greenstone2/cgi-bin/gsdlCGI.pm@ 23468

Last change on this file since 23468 was 23468, checked in by davidb, 13 years ago

Printing to STDERR in IIS sends output (be default) to the web page. This modification detects that is is IIS from the environment variable SERVER_SOFTWARE and redirects STDERR to Greenstone's error.txt file.
  • Property svn:keywords set to Author Date Id Revision
File size: 18.9 KB
Line 
1package gsdlCGI;
2
3# This file merges Michael Dewsnip's gsdlCGI.pm for GS2 and Quan Qiu's gsdlCGI4gs3.pm (GS3)
4
5use strict;
6no strict 'subs';
7no strict 'refs'; # allow filehandles to be variables and viceversa
8
9use CGI;
10use Cwd;
11use MIME::Base64;
12
13@gsdlCGI::ISA = ( 'CGI' );
14
15our $server_software;
16our $server_version;
17
18sub BEGIN {
19 $server_software = $ENV{'SERVER_SOFTWARE'};
20
21 if (defined $server_software) {
22 if ($server_software =~ m/^Microsoft-IIS\/(.*)$/) {
23 $server_version = $1;
24 }
25 }
26}
27
28
29sub prenew {
30 my $class = shift @_;
31
32 my $version;
33 if (-e "gsdl3site.cfg") {
34 $version = 3;
35 } else {
36 $version = 2;
37 }
38
39 my $self = {};
40
41 if ($version == 2) {
42 $self->{'site_filename'} = "gsdlsite.cfg";
43 $self->{'greenstone_version'} = 2;
44 }
45 elsif ($version == 3) {
46 $self->{'site_filename'} = "gsdl3site.cfg";
47 $self->{'greenstone_version'} = 3;
48 }
49
50 my $bself = bless $self, $class;
51
52 $bself->setup_gsdl();
53
54 return $bself;
55}
56
57
58sub new {
59 my $class = shift @_;
60
61 my $self;
62
63 # We'll determine the correct config file in this constructor itself
64 # and use it to determine the Greenstone server's version.
65 # Perhaps later, another test can be used for finding out what version
66 # of the Greenstone server we are working with.
67 my $version;
68 if (-e "gsdl3site.cfg") {
69 $version = 3;
70 } else {
71 $version = 2;
72 }
73
74 # POST that is URL-encoded (like a GET) is a line that needs to be read from STDIN
75 if ((defined $ENV{'CONTENT_TYPE'}) && ($ENV{'CONTENT_TYPE'} =~ m/form-urlencoded/)) {
76 my $line = <STDIN>;
77 if ((defined $line) && ($line ne "")) {
78 $self = new CGI($line);
79 }
80 }
81
82 # If the conditions above did not hold, then self=new CGI(@_)
83 if (!defined $self) {
84 # It's a GET, or else a POST with Multi-part body
85 $self = new CGI(@_);
86 }
87
88
89 if ($version == 2) {
90 $self->{'site_filename'} = "gsdlsite.cfg";
91 $self->{'greenstone_version'} = 2;
92 }
93 elsif ($version == 3) {
94 $self->{'site_filename'} = "gsdl3site.cfg";
95 $self->{'greenstone_version'} = 3;
96 }
97
98 return bless $self, $class;
99}
100
101
102sub parse_cgi_args
103{
104 my $self = shift @_;
105 my $xml = (defined $self->param("xml")) ? 1 : 0;
106
107 $self->{'xml'} = $xml;
108
109 my @var_names = $self->param;
110 my @arg_list = ();
111 foreach my $n ( @var_names ) {
112 my $arg = "$n=";
113 my $val = $self->param($n);
114 $arg .= $val if (defined $val);
115 push(@arg_list,$arg);
116 }
117
118 $self->{'args'} = join("&",@arg_list);
119}
120
121
122sub clean_param
123{
124 my $self = shift @_;
125 my ($param) = @_;
126
127 my $val = $self->SUPER::param($param);
128 $val =~ s/[\r\n]+$// if (defined $val);
129
130 return $val;
131}
132
133sub safe_val
134{
135 my $self = shift @_;
136 my ($val) = @_;
137
138 # convert any encoded entities to true form
139 $val =~ s/&amp;/&/osg;
140 $val =~ s/&lt;/</osg;
141 $val =~ s/&gt;/>/osg;
142 $val =~ s/&quot;/\"/osg;
143 $val =~ s/&nbsp;/ /osg;
144
145
146 # ensure only alpha-numeric plus a few other special chars remain
147
148 $val =~ s/[^[:alnum:]@\.\/\- :_]//g if (defined $val);
149
150 return $val;
151}
152
153sub generate_message
154{
155 my $self = shift @_;
156 my ($message) = @_;
157
158 #if($self->{'greenstone_version'} == 2) { # plain text, for IIS 6
159 print STDOUT "Content-type:text/plain\n\n$message";
160 #} else {
161 #print "Content-type:text/html\n\n";
162 #print "<pre>";
163 #print STDOUT $message;
164 #print "</pre>";
165 #}
166}
167
168sub generate_error
169{
170 my $self = shift @_;
171 my ($mess) = @_;
172
173 my $xml = $self->{'xml'};
174
175 my $full_mess;
176 my $args = $self->{'args'};
177
178 if ($xml) {
179 # Make $args XML safe
180 my $args_xml_safe = $args;
181 $args_xml_safe =~ s/&/&amp;/g;
182
183 $full_mess = "<Error>\n";
184 $full_mess .= " $mess\n";
185 $full_mess .= " CGI args were: $args_xml_safe\n";
186 $full_mess .= "</Error>\n";
187 }
188 else {
189 $full_mess = "ERROR: $mess\n ($args)\n";
190 }
191
192 $self->generate_message($full_mess);
193
194 die $full_mess;
195}
196
197sub generate_warning
198{
199 my $self = shift @_;
200 my ($mess) = @_;
201
202 my $xml = $self->{'xml'};
203
204 my $full_mess;
205 my $args = $self->{'args'};
206
207 if ($xml) {
208 # Make $args XML safe
209 my $args_xml_safe = $args;
210 $args_xml_safe =~ s/&/&amp;/g;
211
212 $full_mess = "<Warning>\n";
213 $full_mess .= " $mess\n";
214 $full_mess .= " CGI args were: $args_xml_safe\n";
215 $full_mess .= "</Warning>\n";
216 }
217 else {
218 $full_mess = "Warning: $mess ($args)\n";
219 }
220
221 $self->generate_message($full_mess);
222
223 print STDERR $full_mess;
224}
225
226
227sub generate_ok_message
228{
229 my $self = shift @_;
230 my ($mess) = @_;
231
232 my $xml = $self->{'xml'};
233
234 my $full_mess;
235
236 if ($xml) {
237 $full_mess = "<Accepted>\n";
238 $full_mess .= " $mess\n";
239 $full_mess .= "</Accepted>\n";
240 }
241 else {
242 $full_mess = "$mess";
243 }
244
245 $self->generate_message($full_mess);
246}
247
248
249
250sub get_config_info {
251 my $self = shift @_;
252 my ($infotype, $optional) = @_;
253
254 my $site_filename = $self->{'site_filename'};
255 open (FILEIN, "<$site_filename")
256 || $self->generate_error("Could not open $site_filename");
257
258 my $config_content = "";
259 while(defined (my $line = <FILEIN>)) {
260 $config_content .= $line;
261 }
262 close(FILEIN);
263
264 my ($loc) = ($config_content =~ m/^$infotype\s+((\".+\")|(\S+))\s*\n/m);
265 $loc =~ s/\"//g if defined $loc;
266
267 if ((!defined $loc) || ($loc =~ m/^\s*$/)) {
268 if((!defined $optional) || (!$optional)) {
269 $self->generate_error("$infotype is not set in $site_filename");
270 }
271 }
272
273 return $loc;
274}
275
276sub get_gsdl3_src_home{
277 my $self = shift @_;
278 if (defined $self->{'gsdl3srchome'}) {
279 return $self->{'gsdl3srchome'};
280 }
281
282 my $gsdl3srchome = $self->get_config_info("gsdl3srchome");
283
284 if(defined $gsdl3srchome) {
285 $gsdl3srchome =~ s/(\/|\\)$//; # remove trailing slash
286 }
287 $self->{'gsdl3srchome'} = $gsdl3srchome;
288
289 return $gsdl3srchome;
290}
291
292
293sub get_gsdl_home {
294 my $self = shift @_;
295
296 if (defined $self->{'gsdlhome'}) {
297 return $self->{'gsdlhome'};
298 }
299
300 my $gsdlhome = $self->get_config_info("gsdlhome");
301
302 $gsdlhome =~ s/(\/|\\)$//; # remove trailing slash
303
304 $self->{'gsdlhome'} = $gsdlhome;
305
306 return $gsdlhome;
307}
308
309sub get_gsdl3_home {
310 my $self = shift @_;
311 my ($optional) = @_;
312
313 if (defined $self->{'gsdl3home'}) {
314 return $self->{'gsdl3home'};
315 }
316
317 my $gsdl3home = $self->get_config_info("gsdl3home", $optional);
318
319 if(defined $gsdl3home) {
320 $gsdl3home =~ s/(\/|\\)$//; # remove trailing slash
321 $self->{'gsdl3home'} = $gsdl3home;
322 }
323 return $gsdl3home;
324}
325
326sub get_java_home {
327 my $self = shift @_;
328 my ($optional) = @_;
329
330 if (defined $self->{'javahome'}) {
331 return $self->{'javahome'};
332 }
333
334 my $javahome = $self->get_config_info("javahome", $optional);
335 if(defined $javahome) {
336 $javahome =~ s/(\/|\\)$//; # remove trailing slash
337 $self->{'javahome'} = $javahome;
338 }
339 return $javahome;
340}
341
342sub get_perl_path {
343 my $self = shift @_;
344 my ($optional) = @_;
345
346 if (defined $self->{'perlpath'}) {
347 return $self->{'perlpath'};
348 }
349
350 my $perlpath = $self->get_config_info("perlpath", $optional);
351
352 if(defined $perlpath) {
353 $perlpath =~ s/(\/|\\)$//; # remove trailing slash
354 $self->{'perlpath'} = $perlpath;
355 }
356 return $perlpath;
357}
358
359sub get_gsdl_os {
360 my $self = shift @_;
361
362 my $os = $^O;
363
364 if ($os =~ m/linux/i) {
365 return "linux";
366 }
367 elsif ($os =~ m/mswin/i) {
368 return "windows";
369 }
370 elsif ($os =~ m/macos/i) {
371 return "darwin";
372 }
373 else {
374 # return as is.
375 return $os;
376 }
377}
378
379sub get_library_url_suffix {
380 my $self = shift @_;
381
382 if (defined $self->{'library_url_suffix'}) {
383 return $self->{'library_url_suffix'};
384 }
385
386 my $optional = 1; # ignore absence of gwcgi if not found
387 my $library_url = $self->get_config_info("gwcgi", $optional);
388 if(defined $library_url) {
389 $library_url =~ s/(\/|\\)$//; # remove trailing slash
390 }
391 else {
392
393 if($self->{'greenstone_version'} == 2) {
394 $library_url = $self->get_config_info("httpprefix", $optional);
395 $library_url = "/greenstone" unless defined $library_url;
396 $library_url = "$library_url/cgi-bin/library.cgi"; # same extension for linux and windows
397 }
398 else { # greenstone 3 or later and gwcgi not defined
399 $library_url = "/greenstone3"; #"/greenstone3/library";
400 }
401 }
402
403 $self->{'library_url_suffix'} = $library_url;
404 return $library_url;
405}
406
407sub setup_fedora_homes {
408 my $self = shift @_;
409 my ($optional) = @_;
410
411 # The following will still allow the FEDORA_HOME and FEDORA_VERSION environment
412 # variables to have been set outside the gsdlsite.cfg file. Existing env vars
413 # are only overwritten if they've *also* been defined in gsdlsite.cfg.
414
415 if (!defined $self->{'fedora_home'}) # Don't need to go through it all again if we'd already done this before
416 {
417 # First look in the gsdlsite.cfg file for the fedora properties to be defined
418 # and set $ENV{FEDORA_HOME} and $ENV{FEDORA_VERSION} if values were provided
419 $self->{'fedora_home'} = $self->get_config_info("fedorahome", $optional);
420
421 if (defined $self->{'fedora_home'}) {
422 $ENV{'FEDORA_HOME'} = $self->{'fedora_home'};
423 }
424 elsif (defined $ENV{'FEDORA_HOME'}) { # check environment variable
425 $self->{'fedora_home'} = $ENV{'FEDORA_HOME'};
426 }
427
428 # if FEDORA_HOME is now defined, we can look for the fedora version that is being used
429 if (defined $ENV{'FEDORA_HOME'})
430 {
431 # first look in the file
432 $self->{'fedora_version'} = $self->get_config_info("fedoraversion", $optional);
433
434 if (defined $self->{'fedora_version'}) {
435 $ENV{'FEDORA_VERSION'} = $self->{'fedora_version'};
436 }
437 elsif (defined $ENV{'FEDORA_VERSION'}) { # then check environment variable
438 $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'};
439 }
440 else { # finally, default to version 3 and warn the user
441 $ENV{'FEDORA_VERSION'} = "3";
442 $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'};
443 #$self->generate_ok_message("FEDORA_HOME is set, but not FEDORA_VERSION, defaulted to: 3.");
444 }
445 }
446 }
447}
448
449sub setup_gsdl {
450 my $self = shift @_;
451 my $optional = 1; # ignore absence of specified properties in gsdl(3)site.cfg if not found
452
453 my $gsdlhome = $self->get_gsdl_home();
454 my $gsdlos = $self->get_gsdl_os();
455 $ENV{'GSDLHOME'} = $gsdlhome;
456 $ENV{'GSDLOS'} = $gsdlos;
457
458 if (defined $server_software) {
459 if ($server_software =~ m/^Microsoft-IIS/) {
460 # Printing to STDERR, by default, goes to the web page in IIS
461 # Send it instead to Greenstone's error.txt
462
463 my $error_filename = "$gsdlhome/etc/error.txt"; # OK for Windows
464 open STDERR, ">> $error_filename"
465 or die "Can't write to $error_filename: $!\n";
466 binmode STDERR;
467 }
468 }
469
470 my $library_url = $self->get_library_url_suffix(); # best to have GSDLOS set beforehand
471 $self->{'library_url_suffix'} = $library_url;
472
473 unshift(@INC, "$ENV{'GSDLHOME'}/cgi-bin"); # This is OK on Windows
474 unshift(@INC, "$ENV{'GSDLHOME'}/perllib");
475 unshift(@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
476 unshift(@INC, "$ENV{'GSDLHOME'}/perllib/cgiactions");
477
478 require util;
479
480 if($self->{'greenstone_version'} == 3) {
481 my $gsdl3srchome = $self->get_gsdl3_src_home();
482 $ENV{'GSDL3SRCHOME'} = $gsdl3srchome;
483
484 my $gsdl3home = $self->get_gsdl3_home($optional);
485 # if a specific location for GS3's web folder is not provided,
486 # assume the GS3 web folder is in the default location
487 if(!defined $gsdl3home) {
488 $gsdl3home = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web");
489 $self->{'gsdl3home'} = $gsdl3home;
490 }
491 $ENV{'GSDL3HOME'} = $gsdl3home;
492 }
493
494
495 my $gsdl_bin_script = &util::filename_cat($gsdlhome,"bin","script");
496 &util::envvar_prepend("PATH",$gsdl_bin_script);
497
498 my $gsdl_bin_os = &util::filename_cat($gsdlhome,"bin",$gsdlos);
499 &util::envvar_prepend("PATH",$gsdl_bin_os);
500
501 # set up ImageMagick for the remote server in parallel to what setup.bash does
502 my $magick_home = &util::filename_cat($gsdl_bin_os,"imagemagick");
503 if(-e $magick_home) {
504 my $magick_bin = &util::filename_cat($magick_home,"bin");
505 my $magick_lib = &util::filename_cat($magick_home,"lib");
506
507 &util::envvar_append("PATH", $magick_bin);
508
509 if(!defined $ENV{'MAGICK_HOME'} || $ENV{'MAGICK_HOME'} eq "") {
510 $ENV{'MAGICK_HOME'} = $magick_home;
511 }
512
513 if($gsdlos eq "linux") {
514 &util::envvar_prepend("LD_LIBRARY_PATH", $magick_lib);
515 } elsif ($gsdlos eq "linux") {
516 &util::envvar_prepend("DYLD_LIBRARY_PATH", $magick_lib);
517 }
518
519 }
520
521 # set up GhostScript for the remote server in parallel to what setup.bash does
522 my $ghostscript_home = &util::filename_cat($gsdl_bin_os,"ghostscript");
523 if(-e $ghostscript_home) {
524 my $ghostscript_bin = &util::filename_cat($ghostscript_home,"bin");
525 &util::envvar_prepend("PATH", $ghostscript_bin);
526
527 if(!defined $ENV{'GS_LIB'} || $ENV{'GS_LIB'} eq "") {
528 $ENV{'GS_LIB'} = &util::filename_cat($ghostscript_home,"share","ghostscript","8.63","lib");
529 }
530 if(!defined $ENV{'GS_FONTPATH'} || $ENV{'GS_FONTPATH'} eq "") {
531 $ENV{'GS_FONTPATH'} = &util::filename_cat($ghostscript_home,"share","ghostscript","8.63","Resource","Font");
532 }
533 }
534
535 # If the "perlpath" property is set in the gsdl(3)site.cfg config file, it is
536 # prepended to PATH only if the same perl bin dir path is not already on PATH env
537 my $perl_bin_dir = $self->get_perl_path($optional);
538 if(defined $perl_bin_dir)
539 {
540 &util::envvar_prepend("PATH", $perl_bin_dir);
541
542 #my ($perl_home) = ($perl_bin_dir =~ m/(.*)[\\|\/]bin[\\|\/]?$/);
543 my ($tailname,$perl_home) = File::Basename::fileparse($perl_bin_dir, "\\.(?:[^\\.]+?)\$");
544 $ENV{'PERL5LIB'} = &util::filename_cat($perl_home, "lib");
545
546 if($gsdlos eq "darwin") {
547 &util::envvar_prepend("DYLD_LIBRARY_PATH", &util::filename_cat($perl_home,"5.8.9","darwin-thread-multi-2level","CORE"));
548 } elsif($gsdlos eq "linux") {
549 &util::envvar_prepend("LD_LIBRARY_PATH", &util::filename_cat($perl_home,"5.8.9","i686-linux-thread-multi","CORE"));
550 }
551 }
552 elsif ($gsdlos eq "windows")
553 {
554 # Perl comes installed with the GS Windows Release Kit. However, note that if GS
555 # is from SVN, the user must have their own Perl and put it on the PATH or set
556 # perlpath in the gsdl site config file.
557 $perl_bin_dir = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin");
558 if(-e $perl_bin_dir) {
559 &util::envvar_append("PATH", $perl_bin_dir);
560 }
561 }
562
563 # If javahome is explicitly set in the gsdl site config file then it will override
564 # any env variable JAVA_HOME. A GS2 server does not set JAVA_HOME, though java is on
565 # the path. Therefore, if Fedora is being used for FLI with GS2, then javahome must
566 # be set in gsdlsite.cfg or the JAVA_HOME env var must be explicitly set by the user.
567 my $java_home = $self->get_java_home($optional);
568 if(defined $java_home) {
569 $ENV{'JAVA_HOME'} = $java_home;
570 }
571
572 # Process any extension setup.pl files
573 my $ext_home = &util::filename_cat($gsdlhome,"ext");
574
575 if (opendir(EXTDIR,$ext_home) ) {
576 my @pot_ext_dir = grep { $_ !~ m/^\./ } readdir(EXTDIR);
577
578 closedir(EXTDIR);
579
580 foreach my $ed (@pot_ext_dir) {
581 my $full_ext_dir = &util::filename_cat($ext_home,$ed);
582 if (-d $full_ext_dir) {
583 my $full_inc_file = &util::filename_cat($full_ext_dir,
584 "$ed-setup.pl");
585 if (-f $full_inc_file) {
586
587 my $store_cwd = Cwd::cwd();
588
589 chdir($full_ext_dir);
590 require "./$ed-setup.pl";
591 chdir($store_cwd);
592 }
593 }
594 }
595 }
596
597 # FEDORA_HOME and FEDORA_VERSION are needed (by scripts g2f-import and g2f-buildcol).
598 $self->setup_fedora_homes($optional);
599}
600
601sub greenstone_version {
602 my $self = shift @_;
603 return $self->{'greenstone_version'};
604}
605
606sub library_url_suffix {
607 my $self = shift @_;
608 return $self->{'library_url_suffix'};
609}
610
611# Only useful to call this after calling setup_gsdl, as it uses some environment variables
612# Returns the Greenstone collect directory, or a specific collection directory inside collect
613sub get_collection_dir {
614 my $self = shift @_;
615 my ($site, $collection) = @_; # both may be undefined
616
617 my $collection_directory;
618 if($self->{'greenstone_version'} == 2 && defined $ENV{'GSDLHOME'}) {
619 if(defined $collection) {
620 $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection);
621 } else {
622 $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect");
623 }
624 }
625 elsif($self->{'greenstone_version'} == 3 && defined $ENV{'GSDL3SRCHOME'}) {
626 if(defined $collection) {
627 $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect", $collection);
628 } else {
629 $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect");
630 }
631 }
632}
633
634sub local_rm_r
635{
636 my $self = shift @_;
637 my ($local_dir) = @_;
638
639 my $prefix_dir = getcwd();
640 my $full_path = &util::filename_cat($prefix_dir,$local_dir);
641
642 if ($prefix_dir !~ m/collect/) {
643 $self->generate_error("Trying to delete outside of Greenstone collect: $full_path");
644 }
645
646 # Delete recursively
647 if (!-e $full_path) {
648 $self->generate_error("File/Directory does not exist: $full_path");
649 }
650
651 &util::rm_r($full_path);
652}
653
654
655sub get_java_path()
656{
657 # Check the JAVA_HOME environment variable first
658 if (defined $ENV{'JAVA_HOME'}) {
659 my $java_home = $ENV{'JAVA_HOME'};
660 $java_home =~ s/\/$//; # Remove trailing slash if present (Unix specific)
661 return &util::filename_cat($java_home, "bin", "java");
662 }
663
664 # Hope that Java is on the PATH
665 return "java";
666}
667
668
669sub check_java_home()
670{
671 # Return a warning unless the JAVA_HOME environment variable is set
672 if (!defined $ENV{'JAVA_HOME'}) {
673 return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")";
674 }
675
676 return "";
677}
678
679
680sub checked_chdir
681{
682 my $self = shift @_;
683 my ($dir) = @_;
684
685 if (!-e $dir) {
686 $self->generate_error("Directory '$dir' does not exist");
687 }
688
689 chdir $dir
690 || $self->generate_error("Unable to change to directory: $dir");
691}
692
693sub rot13()
694{
695 my $self = shift @_;
696 my ($password)=@_;
697 my @password_arr=split(//,$password);
698
699 my @encrypt_password;
700 foreach my $str (@password_arr){
701 my $char=unpack("c",$str);
702 if ($char>=97 && $char<=109){
703 $char+=13;
704 }elsif ($char>=110 && $char<=122){
705 $char-=13;
706 }elsif ($char>=65 && $char<=77){
707 $char+=13;
708 }elsif ($char>=78 && $char<=90){
709 $char-=13;
710 }
711 $char=pack("c",$char);
712 push(@encrypt_password,$char);
713 }
714 return join("",@encrypt_password);
715}
716
717sub encrypt_password
718{
719 my $self = shift @_;
720
721 if (defined $self->param("pw")) { ##
722 if ($self->{'greenstone_version'} == 3) { # GS3 is in Java, so needs different encryption
723 $self->param('-name' => "pw", '-value' => $self->rot13($self->clean_param("pw")));
724 }
725 else { # GS2 (and versions of GS other than 3?)
726 #require "$self->{'gsdlhome'}/perllib/util.pm"; # This is OK on Windows
727 require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm"; # This is OK on Windows
728 $self->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("pw"), "Tp"));
729 }
730 }
731}
732
733
734sub decode {
735 my ($self, $text) = @_;
736 $text =~ s/\+/ /g;
737 $text = &MIME::Base64::decode_base64($text);
738
739 return $text;
740}
741
7421;
743
Note: See TracBrowser for help on using the repository browser.