Changeset 10206


Ignore:
Timestamp:
2005-07-05T12:16:43+12:00 (19 years ago)
Author:
davidb
Message:

Modifications to make perl code compatible with Windows. Main change has
been to use platform independent calls to manipulates files.

Location:
trunk/gsdl/cgi-bin
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/gsdl/cgi-bin/download

    r9898 r10206  
    1 #!/usr/bin/perl -w
     1#!perl -w
    22
    33use gsdlCGI;
    … …  
    1414    my $gsdl_cgi = new gsdlCGI("+cmdline");
    1515
    16     my $gsdlhome = $gsdl_cgi->get_gsdl_home();
    17 
    18     $ENV{'GSDLOS'} = "linux";
     16    $gsdl_cgi->setup_gsdl();
     17    my $gsdlhome = $ENV{'GSDLHOME'};
    1918
    2019    load_gsdl_utils($gsdlhome);
    … …  
    6160    = &util::filename_cat($gsdlhome,"bin","java","SignedGatherer.jar");
    6261    my $java_prog = "org.greenstone.gatherer.util.Zipup";
    63     my $java_args = "$zip_dirname/ $col $dir $accept_expr $reject_expr";
     62    my $java_args = "$zip_dirname $col $dir $accept_expr $reject_expr";
    6463    my $java_cmd = "$java -classpath $classpath $java_prog $java_args";
    6564
    66     `$java_cmd`;
     65    my $java_output = `$java_cmd`;
    6766
     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   
    6876    my $zip_filename = &util::filename_cat($zip_dirname,"$col.zip");
    6977
    … …  
    8290
    8391    close(PIN);
    84 
    85     my $status = $?;
    8692    }
    8793    else {

  • trunk/gsdl/cgi-bin/gsdlCGI.pm

    r9941 r10206  
    33
    44use CGI;
     5use Cwd;
    56
    67@ISA = ('CGI');
    … …  
    9495}
    9596
     97sub generate_warning
     98{
     99    my $self = shift @_;
     100    my ($mess) = @_;
     101   
     102    my $xml = $self->{'xml'};
     103
     104    my $full_mess;
     105    my $args = $self->{'args'};
     106
     107    if ($xml) {
     108    $full_mess =  "<Warning>\n";
     109    $full_mess .= "  $mess\n";
     110    $full_mess .= "  CGI args were: $args\n";
     111    $full_mess .= "</Warning>\n";
     112    }
     113    else {
     114    $full_mess = "Warning: $mess ($args)\n";
     115    }
     116
     117    print STDOUT "Content-type:text/plain\n\n";
     118    print STDOUT $full_mess;
     119
     120    print STDERR $full_mess;
     121}
     122
    96123
    97124sub generate_ok_message
    … …  
    145172}
    146173
     174
    147175sub get_gsdl_home {
    148176    my $self = shift @_;
     177   
     178    if (defined $self->{'gsdlhome'}) {
     179    return $self->{'gsdlhome'};
     180    }
    149181
    150182    my $gsdlhome = $self->get_config_info("gsdlhome");
    151183
    152     # Unix specific
    153     $gsdlhome =~ s/\/$//; # remove trailing slash
     184    require "$gsdlhome/perllib/util.pm";
     185
     186    $gsdlhome =~ s/(\/|\\)$//; # remove trailing slash
     187
     188    $self->{'gsdlhome'} = $gsdlhome;
    154189
    155190    return $gsdlhome;
    156191}
    157192
    158 
    159 sub rm_rf
    160 {
    161     my $self = shift @_;
    162     my ($dir) = @_;
    163 
    164     # Delete recursively with force flag on
    165 
    166     # Currently, Unix specific, need to generalise to Windows etc.
    167     # => hook in with util.pm ?
    168 
    169     my $cmd = "/bin/rm -rf $dir 2>&1"; # Unix specific
    170 
    171     my $output = `$cmd`;
    172 
    173     if ($?>0) {
    174     $self->generate_error("Failed to delete directory: $dir\n\n$output");
    175     }
    176 }
    177 
    178 sub mkdir
    179 {
    180     my $self = shift @_;
    181     my ($dir) = @_;
    182 
    183 
    184     # Currently, Unix specific, need to generalise to Windows etc.
    185     # => hook in with util.pm ?
    186 
    187     my $cmd = "mkdir $dir 2>&1"; # Unix specific
    188 
    189     my $output = `$cmd`;
    190 
    191     if ($?>0) {
    192     $self->generate_error("Failed to create directory: $dir\n\n$output");
    193     }
    194 }
     193sub get_gsdl_os {
     194    my $self = shift @_;
     195   
     196    my $os = $^O;
     197
     198    if ($os =~ m/linux/i) {
     199    return "linux";
     200    }
     201    elsif ($os =~ /mswin/i) {
     202    return "windows";
     203    }
     204    elsif ($os =~ /macos/i) {
     205    return "darwin";
     206    }
     207    else {
     208    # return as is.
     209    return $os;
     210    }
     211}
     212
     213sub setup_gsdl {
     214    my $self = shift @_;
     215
     216    $ENV{'GSDLHOME'} = $self->get_gsdl_home();
     217    $ENV{'GSDLOS'} = $self->get_gsdl_os();
     218}
     219
     220
     221sub local_rm_r
     222{
     223    my $self = shift @_;
     224    my ($local_dir) = @_;
     225
     226    my $prefix_dir = getcwd();
     227
     228    if ($prefix_dir !~ m/collect/) {
     229    $self->generate_error("Trying to delete outside of Greenstone collect: $full_dir");
     230    }
     231
     232    my $full_dir = &util::filename_cat($prefix_dir,$local_dir);
     233
     234    # Delete recursively
     235    if (!-e $full_dir) {
     236    $self->generate_error("File/Directory does not exist: $full_dir");
     237    }
     238
     239    &util::rm_r($full_dir);
     240}
     241
     242
    195243
    196244sub check_for_java()
    … …  
    204252    # Unix specific
    205253    $java_home =~ s/\/$//; # remove trailing slash if present
    206     $java = "$java_home/bin/java"; # Unix specific
    207     }
    208     else {
    209     $self->generate_error("Unable to file java");
    210     }
    211 
    212 
     254
     255    $java = &util::filename_cat($java_home,"bin","java");
     256    }
     257    else {
     258    my $path = $ENV{'PATH'};
     259    my $mess = "JAVA_HOME environment variable not set.  Might not be able to find java unless in PATH=$path";
     260
     261    $self->generate_warning($mess);
     262    }
     263   
    213264    return $java;
    214265}
    215266
    216 sub unix_cmd
    217 {
    218     my $self = shift @_;
    219     my ($cmd) = @_;
    220 
    221     $cmd = "( $cmd ) 2>&1";
    222 
    223     my $output = `$cmd`;
    224 
    225     if ($?>0) {
    226     $self->generate_error("Failed to run command: $cmd\n\n$output");
    227     }
    228 }
    229267
    230268sub checked_chdir
    … …  
    242280
    2432811;
     282

  • trunk/gsdl/cgi-bin/launch

    r9898 r10206  
    1 #!/usr/bin/perl -w
     1#!perl -w
    22
    33use gsdlCGI;
    … …  
    1616    my @arg_keys = $gsdl_cgi->param;
    1717
    18     if (!-e "setup.bash") {
    19     my $note = "Note: Server side for Greenstone applet must currently be Unix based.";
    20 
    21     $gsdl_cgi->generate_error("Unable to locate setup.bash\n$note");
    22     }
    23 
    24     # Unix specific, need to generalise to Windows etc.
    25     my $cmd = "source setup.bash > /dev/null ; $prog.pl ";
     18    my $os = $gsdl_cgi->get_gsdl_os();
     19
     20    my $gsdlhome = $ENV{'GSDLHOME'};
     21    $ENV{'PATH'} .= ";$perlhome\\bin";
     22    $ENV{'PATH'} .= ";$gsdlhome\\bin\\script";
     23    $ENV{'PATH'} .= ";$gsdlhome\\bin\\windows";
     24    $ENV{'PATH'} .= ";$gsdlhome\\bin\\windows\\perl\\bin";
     25
     26    my $cmd = "perl -S $prog.pl ";
    2627
    2728    foreach my $k ( @arg_keys ) {
    … …  
    4445
    4546    my $status;
    46    
     47
    4748    print STDOUT "Content-type:text/plain\n\n";
     49
     50    my $report = "";
    4851
    4952    if (open(PIN,"$cmd 2>&1 |")) {
    5053    while (defined (my $line=<PIN>)) {
    5154        print STDOUT $line;
     55        $report .= $line;
    5256    }
    5357    close(PIN);
    … …  
    5660
    5761    if ($status>0) {
    58         my $exit_status = "Exit status: $status";
    59         $gsdl_cgi->generate_error( "'".$cmd."' failed.\n$exit_status");
     62        $status = $status/256;
     63        my $exit_status = "Exit status: $status\n";
     64        my $mess = "'".$cmd."' failed.\n$report\n$exit_status";
     65        $gsdl_cgi->generate_error($mess);
    6066    }
    6167    }
    … …  
    101107sub run_buildcol
    102108{
    103     my ($col,$gsdl_cgi) = @_;
    104    
     109    my ($gsdlhome,$col,$gsdl_cgi) = @_;
     110   
     111    my $full_col_dir  = &util::filename_cat($gsdlhome,"collect",$col);
     112    my $full_building = &util::filename_cat($full_col_dir,"building");
     113    my $full_index    = &util::filename_cat($full_col_dir,"index");
     114
    105115    if (defined $col) {
    106     $gsdl_cgi->checked_chdir("collect/$col");
    107     $gsdl_cgi->rm_rf("building/*");
    108     $gsdl_cgi->checked_chdir("../..");
     116    &util::rm_r($full_building);
     117    &util::mk_dir($full_building);
    109118    }
    110119
    … …  
    113122    if ($status == 0) {
    114123    if (defined $col) {
    115         $gsdl_cgi->checked_chdir("collect/$col");
    116         $gsdl_cgi->rm_rf("index");
    117         $gsdl_cgi->unix_cmd("/bin/cp -r building index");
    118         $gsdl_cgi->checked_chdir("../..");
     124        &util::rm_r($full_index);
     125
     126        # While it is more efficient to move the building directory
     127        # to become the index folder, this gets things out of order
     128        # back on the client.  Use copy for now as this makes things
     129        # simpler for now.
     130
     131        my $full_building_here = &util::filename_cat($full_building,".");
     132        &util::cp_r($full_building_here,$full_index);
    119133    }
    120134    }
    … …  
    180194    $dir = "" if ($dir eq ".");
    181195
    182     $gsdl_cgi->rm_rf("$col/$dir");
     196    $gsdl_cgi->local_rm_r("$col/$dir");
    183197    $gsdl_cgi->checked_chdir("..");
    184198
    … …  
    189203{
    190204    my $gsdl_cgi = new gsdlCGI("+cmdline");
    191     my $gsdlhome = $gsdl_cgi->get_gsdl_home();
    192 
    193     $ENV{'GSDLOS'} = "linux";
     205
     206    $gsdl_cgi->setup_gsdl();
     207    my $gsdlhome = $ENV{'GSDLHOME'};
    194208
    195209    load_gsdl_utils($gsdlhome);
    … …  
    224238    }
    225239    elsif ($cmd eq "buildcol") {
    226     run_buildcol($col,$gsdl_cgi);
     240    run_buildcol($gsdlhome,$col,$gsdl_cgi);
    227241    }
    228242    elsif ($cmd eq "exportcol") {
    … …  
    238252    $gsdl_cgi->generate_error("unrecognised command: '$cmd'");
    239253    }
    240    
    241254}
    242255

  • trunk/gsdl/cgi-bin/upload

    r10198 r10206  
    1 #!/usr/bin/perl -w
     1#!perl -w
    22
    33use gsdlCGI;
    44
     5sub load_gsdl_utils
     6{
     7    my ($gsdlhome) = @_;
     8
     9    require "$gsdlhome/perllib/util.pm";
     10}
     11
    512sub main
    613{
     14    my $gsdl_cgi = new gsdlCGI();
    715
    8     my $gsdl_cgi = new gsdlCGI();
    9     my $gsdlhome = $gsdl_cgi->get_gsdl_home();
     16    $gsdl_cgi->setup_gsdl();
     17    my $gsdlhome = $ENV{'GSDLHOME'};
     18
     19    load_gsdl_utils($gsdlhome);
    1020
    1121    my $col = $gsdl_cgi->clean_param("c");
    … …  
    1424    }
    1525
     26    my $full_col = &util::filename_cat($gsdlhome,"collect",$col);
     27
    1628    #If the collection dir on the server somehow got erased, create it.
    17     if(!-e "$gsdlhome/collect/$col") {
    18     `mkdir $gsdlhome/collect/$col`;
     29    if(!-e $full_col) {
     30    &util::mk_dir($full_col);
    1931    }
    2032
    … …  
    4153    }
    4254
    43     my $col_dir = "$col/$dir"; # Unix specific
     55    my $col_dir = &util::filename_cat($col,$dir);
     56    my $full_col_dir = &util::filename_cat($full_col,$dir);
    4457
    45 ##    my $java = $gsdl_cgi->check_for_java();
    46 
    47 #    if($delete eq "all") {
    48 #   $gsdl_cgi->rm_rf($col_dir);
    49 #    }
    50 #    elsif($delete eq "files") {
    51 #   `java -classpath $gsdlhome/bin/java/SignedGatherer.jar org.greenstone.gatherer.util.Delete $gsdlhome/collect/$col_dir -reject "metadata\\.xml"`;
    52 #    }
    53 #    elsif($delete eq "metadata") {
    54 #   `java -classpath $gsdlhome/bin/java/SignedGatherer.jar org.greenstone.gatherer.util.Delete $gsdlhome/collect/$col_dir -accept "metadata\\.xml"`;
    55 #    }
    56    
    5758    if($delete eq "all") {
    58     $gsdl_cgi->rm_rf($col_dir);
     59    $gsdl_cgi->local_rm_r($col_dir);
    5960    }
    6061    elsif($delete eq "files") {
    61     if (-e "$gsdlhome/collect/$col_dir") {
    62         `cd $gsdlhome/collect/$col_dir; find -not -name "metadata.xml" -exec rm {} \\;`;
    63     }
     62    my $full_col_dir = &util::filename_cat($gsdlhome,"collect",$col_dir);
     63    # delete everything except metadata.xml files
     64    &util::filtered_rm_r($full_col_dir,undef,"metadata.xml\$");
    6465    }
    6566    elsif($delete eq "metadata") {
    66     if (-e "$gsdlhome/collect/$col_dir") {
    67         `cd $gsdlhome/collect/$col_dir; find -name "metadata.xml" -exec rm {} \\;`;
    68     }
     67    my $full_col_dir = &util::filename_cat($gsdlhome,"collect",$col_dir);
     68    # delete only metadata xml files
     69    &util::filtered_rm_r($full_col_dir,"metadata.xml\$",undef);
    6970    }
    7071
    71     if (!-e $col_dir) {
    72     my $mkdir_cmd = "mkdir $col_dir";
    73     $gsdl_cgi->unix_cmd($mkdir_cmd);
     72    if(!-e $full_col_dir) {
     73    &util::mk_dir($full_col_dir);
    7474    }
    75    
     75
    7676    if (open(ZOUT,"> $zip_fname")) {
    77    
     77    binmode(ZOUT);
     78
    7879    my $ZIN = $gsdl_cgi->upload('zip');
    7980    binmode($ZIN);
    … …  
    9091    close(ZOUT);
    9192
    92     #print STDERR "**** Debug as /tmp/$dir.zip\n";
    93     #`cp $zip_fname /tmp/mgw5/$dir.zip`;
    94 
    9593    my $java = $gsdl_cgi->check_for_java();
    9694
    97     `$java -classpath $gsdlhome/bin/java/SignedGatherer.jar org.greenstone.gatherer.util.Unzip $gsdlhome/ $zip_fname`;
     95    my $classpath = &util::filename_cat($gsdlhome,"bin","java",
     96                        "SignedGatherer.jar");
    9897
     98    my $java_cmd = "$java -classpath \"$classpath\" org.greenstone.gatherer.util.Unzip \"$gsdlhome\" \"$zip_fname\"";
     99
     100    my $java_output = `$java_cmd`;
     101   
     102    my $status = $?;
    99103    unlink "$zip_fname";
    100104
     105    if ($status>0) {
     106        $status = $status/256;
     107        my $exit_status = "Exit status: $status\n";
     108        my $mess = "Java failed: $java_cmd\n--\n$java_output\n$exit_status";
     109        $gsdl_cgi->generate_error($mess);
     110    }
     111   
    101112    $gsdl_cgi->generate_ok_message("$dir or $col uploaded successfully.");
    102113    }
Note: See TracChangeset for help on using the changeset viewer.