Changeset 1454 for trunk


Ignore:
Timestamp:
2000-08-27T23:04:47+12:00 (24 years ago)
Author:
stefan
Message:

Lots of changes to perl building code for collectoraction

Location:
trunk/gsdl
Files:
1 added
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/gsdl/bin/script/build

    r1452 r1454  
    44# windows (build.bat is in bin\windows)
    55
     6package build;
     7
    68use FileHandle;
     9use File::Copy;
    710
    811BEGIN {
    … …  
    2023use parsargv;
    2124use util;
    22 
    23 if (!parsargv::parse(\@ARGV,
    24              'append', \$append,
    25              'remove_archives', \$remove_archives,
    26              'remove_import', \$remove_import,
    27              'buildtype/^(build|import)$/import', \$buildtype,
    28              'maxdocs/^\-?\d+/-1', \$maxdocs,
    29              'download/.+', \@download,
    30              'out/.*/STDERR', \$out)) {
    31    
    32     &print_usage();
    33     die "\n";
    34 }
     25use cfgread;
     26
     27&parse_args (\@ARGV);
    3528
    3629my ($collection) = @ARGV;
    … …  
    4235}
    4336
     37if ($optionfile =~ /\w/) {
     38    open (OPTIONS, $optionfile) || die "Couldn't open $optionfile\n";
     39    my $line = [];
     40    my $options = [];
     41    while (defined ($line = &cfgread::read_cfg_line ('build::OPTIONS'))) {
     42    push (@$options, @$line);
     43    }
     44    close OPTIONS;
     45    &parse_args ($options);
     46}
     47
    4448if ($maxdocs == -1) {
    4549    $maxdocs = "";
    … …  
    4852}
    4953
    50 my $collectdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
    51 my $importdir = &util::filename_cat ($collectdir, "import");
    52 my $archivedir = &util::filename_cat ($collectdir, "archives");
    53 my $buildingdir = &util::filename_cat ($collectdir, "building");
    54 my $indexdir = &util::filename_cat ($collectdir, "index");
     54my $cdir = $collectdir;
     55$cdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect") unless $collectdir =~ /\w/;
     56my $importdir = &util::filename_cat ($cdir, $collection, "import");
     57my $archivedir = &util::filename_cat ($cdir, $collection, "archives");
     58my $buildingdir = &util::filename_cat ($cdir, $collection, "building");
     59my $indexdir = &util::filename_cat ($cdir, $collection, "index");
    5560my $bindir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin");
    5661
    … …  
    6873$out->autoflush(1);
    6974
     75# delete any .kill file left laying around from a previously aborted build
     76if (-e &util::filename_cat ($cdir, $collection, ".kill")) {
     77    &util::rm (&util::filename_cat ($cdir, $collection, ".kill"));
     78}
     79
    7080&main();
    7181
    … …  
    7585    print STDERR "\n  usage: $0 [options] collection-name\n\n";
    7686    print STDERR "  options:\n";
     87    print STDERR "   -optionfile file        Get options from file, useful on systems where\n";
     88    print STDERR "                           long command lines may cause problems\n";
    7789    print STDERR "   -append                 Add new files to existing collection\n";
    7890    print STDERR "   -remove_archives        Remove archives directory after successfully\n";
    … …  
    90102    print STDERR "                           deleted to make way for the downloaded data if\n";
    91103    print STDERR "                           a -download option is supplied\n";
     104    print STDERR "   -collectdir directory   Collection directory (defaults to " .
     105    &util::filename_cat ($ENV{'GSDLHOME'}, "collect") . ")\n";
     106    print STDERR "   -dontinstall            Only applicable if -collectdir is set to something\n";
     107    print STDERR "                           other than the default. -dontinstall will suppress the\n";
     108    print STDERR "                           default behaviour which is to install the collection to\n";
     109    print STDERR "                           the gsdl/collect directory once it has been built.\n";
     110    print STDERR "   -save_archives          Create a copy of the existing archives directory called\n";
     111    print STDERR "                           archives.org\n";
    92112    print STDERR "   -out                    Filename or handle to print output status to.\n";
    93113    print STDERR "                           The default is STDERR\n\n";
    … …  
    95115
    96116sub main {
    97    
     117
     118    if ($save_archives && -d $archivedir) {
     119    print $out "caching original archives to ${archivedir}.org\n";
     120    &util::cp_r ($archivedir, "${archivedir}.org");
     121    }
     122
    98123    # do the download thing if we have any -download options
    99124    if (scalar (@download)) {
    … …  
    103128        &util::rm_r ($importdir);
    104129    }
    105 
     130   
    106131    foreach $download_dir (@download) {
    107132       
    … …  
    120145            # copy download_dir and all it contains to the import directory
    121146            my $download_cmd = "perl " . &util::filename_cat ($bindir, "script", "filecopy.pl");
     147            $download_cmd .= " -collectdir \"$collectdir\"" if $collectdir =~ /\w/;
    122148            $download_cmd .= " -out \"$outfile.download\"" if $use_out;
    123149            $download_cmd .= " \"" . $download_dir . "\" " . $collection;
    … …  
    165191    }
    166192    }
     193
     194    if ($collectdir ne "" && !$dontinstall) {
     195    my $install_collectdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect");
     196    if (!&util::filenames_equal ($collectdir, $install_collectdir)) {
     197       
     198        # install collection to gsdl/collect
     199        print $out "installing the $collection collection\n";
     200        my $newdir = &util::filename_cat ($install_collectdir, $collection);
     201        my $olddir = &util::filename_cat ($collectdir, $collection);
     202        if (-d $newdir) {
     203        print $out "build: Could not install collection as $newdir\n";
     204        print $out "       already exists. Collection will remain at\n";
     205        print $out "       $olddir\n";
     206        &final_out (4) if $use_out;
     207        die "\n";
     208        }
     209        if (!&File::Copy::move ($olddir, $newdir)) {
     210        print $out "build: Failed to install collection to $newdir\n";
     211        print $out "       Collection will remain at $olddir\n";
     212        &final_out (5) if $use_out;
     213        die "\n";
     214        }
     215    }
     216    }
     217
    167218    &final_out (0) if $use_out;
    168219}
    … …  
    175226    $import_cmd .= " -out \"$outfile.import\"" if $use_out;
    176227    $import_cmd .= " -removeold" unless $append;
     228    $import_cmd .= " -collectdir \"$collectdir\"" if $collectdir =~ /\w/;
    177229    $import_cmd .= " $maxdocs $collection";
    178230    system ($import_cmd);
    … …  
    188240    } else {
    189241    &final_out (2) if $use_out;
    190     die "\nimport.pl failed\n";
     242    print $out "\nimport.pl failed\n";
     243    die "\n";
    191244    }
    192245}
    … …  
    198251    my $build_cmd = "perl " . &util::filename_cat ($bindir, "script", "buildcol.pl");
    199252    $build_cmd .= " -out \"$outfile.build\"" if $use_out;
     253    $build_cmd .= " -collectdir \"$collectdir\"" if $collectdir =~ /\w/;
    200254    $build_cmd .= " $maxdocs $collection";
    201255    system ($build_cmd);
    … …  
    211265    }
    212266    } else {
    213     &final_out (2) if $use_out;
    214     die "\nbuildcol.pl failed\n";
     267    &final_out (3) if $use_out;
     268    print $out "\nbuildcol.pl failed\n";
     269    die "\n";
    215270    }
    216271
    … …  
    221276    }
    222277    rmdir ($indexdir) if -d $indexdir;
    223     rename ($buildingdir, $indexdir);
     278    &File::Copy::move ($buildingdir, $indexdir);
     279
     280    # remove the cached arhives
     281    if ($save_archives) -d "${archivedir}.org") {
     282    &util::rm_r ("${archivedir}.org");
     283    }
    224284}
    225285
    … …  
    263323    }
    264324}
     325
     326sub parse_args {
     327    my ($argref) = @_;
     328
     329    if (!parsargv::parse($argref,
     330             'optionfile/.*/', \$optionfile,
     331             'append', \$append,
     332             'remove_archives', \$remove_archives,
     333             'remove_import', \$remove_import,
     334             'buildtype/^(build|import)$/import', \$buildtype,
     335             'maxdocs/^\-?\d+/-1', \$maxdocs,
     336             'download/.+', \@download,
     337             'collectdir/.*/', \$collectdir,
     338             'dontinstall', \$dontinstall,
     339             'save_archives', \$save_archives,
     340             'out/.*/STDERR', \$out)) {
     341   
     342    &print_usage();
     343    die "\n";
     344    }
     345}

  • trunk/gsdl/bin/script/buildcol.pl

    r1431 r1454  
    6262    print STDERR "                         installed along with relevant perl modules\n";
    6363    print STDERR "                         to allow scripting from perl\n";
     64    print STDERR "   -collectdir directory Collection directory (defaults to " .
     65    &util::filename_cat ($ENV{'GSDLHOME'}, "collect") . ")\n";
    6466    print STDERR "   -out                  Filename or handle to print output status to.\n";
    6567    print STDERR "                         The default is STDERR\n\n";
    … …  
    7173    my ($verbosity, $archivedir, $cachedir, $builddir, $maxdocs,
    7274    $debug, $mode, $indexname, $keepold, $allclassifications,
    73     $create_images, $out);
     75    $create_images, $collectdir, $out);
    7476    if (!parsargv::parse(\@ARGV,
    7577             'verbosity/\d+/2', \$verbosity,
    … …  
    8486             'allclassifications', \$allclassifications,
    8587             'create_images', \$create_images,
     88             'collectdir/.*/', \$collectdir,
    8689             'out/.*/STDERR', \$out)) {
    8790    &print_usage();
    … …  
    98101
    99102    # get and check the collection
    100     if (($collection = &util::use_collection(@ARGV)) eq "") {
     103    if (($collection = &util::use_collection(@ARGV, $collectdir)) eq "") {
    101104    &print_usage();
    102105    die "\n";
    … …  
    132135    # fill in the default archives and building directories if none
    133136    # were supplied, turn all \ into / and remove trailing /
    134     $archivedir = "$ENV{'GSDLCOLLECTDIR'}/archives" if $archivedir eq "";
     137    $archivedir = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "archives") if $archivedir eq "";
    135138    $archivedir =~ s/[\\\/]+/\//g;
    136139    $archivedir =~ s/\/$//;
    137     $builddir = "$ENV{'GSDLCOLLECTDIR'}/building" if $builddir eq "";
     140    $builddir = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "building") if $builddir eq "";
    138141    $builddir =~ s/[\\\/]+/\//g;
    139142    $builddir =~ s/\/$//;

  • trunk/gsdl/bin/script/filecopy.pl

    r1431 r1454  
    4343
    4444    print STDERR "  options:\n";
     45    print STDERR "   -collectdir directory   Collection directory (defaults to " .
     46    &util::filename_cat ($ENV{'GSDLHOME'}, "collect") . ")\n";
    4547    print STDERR "   -out                  Filename or handle to print output status to.\n";
    4648    print STDERR "                         The default is STDERR\n\n";
    … …  
    5153    my $dirname = pop(@_);
    5254    my $full_importname
    53     = &util::filename_cat($ENV{'GSDLHOME'},"collect",$dirname,"import");
     55    = &util::filename_cat($collectdir, $dirname, "import");
     56
     57    print $out "full_importname: $full_importname\n";
    5458
    5559    # split argv into 2 lists: files and directories
    … …  
    144148sub main
    145149{
    146     if (!parsargv::parse(\@ARGV, 'out/.*/STDERR', \$out)) {
     150    if (!parsargv::parse(\@ARGV,
     151             'collectdir/.*/', \$collectdir,
     152             'out/.*/STDERR', \$out)) {
    147153    &print_usage();
    148154    die "\n";
     155    }
     156
     157    if ($collectdir !~ /\w/) {
     158    $collectdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect");
    149159    }
    150160

  • trunk/gsdl/bin/script/import.pl

    r1431 r1454  
    6565    print STDERR "                          building. This will be disabled if groupsize > 1\n";
    6666    print STDERR "   -debug                 Print imported text to STDOUT\n";
     67    print STDERR "   -collectdir directory  Collection directory (defaults to " .
     68    &util::filename_cat ($ENV{'GSDLHOME'}, "collect") . ")\n";
    6769    print STDERR "   -out                   Filename or handle to print output status to.\n";
    6870    print STDERR "                          The default is STDERR\n\n";
    … …  
    7577    $removeold, $gzip, $groupsize, $debug, $maxdocs, $collection,
    7678    $configfilename, $collectcfg, $pluginfo, $sortmeta,
    77     $archive_info_filename, $archive_info, $processor, $out);
     79    $archive_info_filename, $archive_info, $processor,
     80    $out, $collectdir);
    7881    if (!parsargv::parse(\@ARGV,
    7982             'verbosity/\d+/2', \$verbosity,
    … …  
    8790             'debug', \$debug,
    8891             'maxdocs/^\-?\d+/-1', \$maxdocs,
     92             'collectdir/.*/', \$collectdir,
    8993             'out/.*/STDERR', \$out)) {
    9094    &print_usage();
    … …  
    104108
    105109    # get and check the collection name
    106     if (($collection = &util::use_collection(@ARGV)) eq "") {
     110    if (($collection = &util::use_collection(@ARGV, $collectdir)) eq "") {
    107111    &print_usage();
    108112    die "\n";
    … …  
    126130    # get the list of plugins for this collection
    127131    my $plugins = [];
    128     $configfilename = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "etc/collect.cfg");
     132    $configfilename = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "etc", "collect.cfg");
    129133    if (-e $configfilename) {
    130134    $collectcfg = &colcfg::read_collect_cfg ($configfilename);
    … …  
    152156    # fill in the default import and archives directories if none
    153157    # were supplied, turn all \ into / and remove trailing /
    154     $importdir = "$ENV{'GSDLCOLLECTDIR'}/import" if $importdir eq "";
     158    $importdir = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "import") if $importdir eq "";
    155159    $importdir =~ s/[\\\/]+/\//g;
    156160    $importdir =~ s/\/$//;
    157     $archivedir = "$ENV{'GSDLCOLLECTDIR'}/archives" if $archivedir eq "";
     161    $archivedir = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "archives") if $archivedir eq "";
    158162    $archivedir =~ s/[\\\/]+/\//g;
    159163    $archivedir =~ s/\/$//;

  • trunk/gsdl/bin/script/mkcol.pl

    r1427 r1454  
    3131# text within the files to match the parameters.
    3232
     33package mkcol;
     34
    3335BEGIN {
    3436    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
    … …  
    3840use parsargv;
    3941use util;
     42use cfgread;
    4043
    4144sub print_usage {
    4245    print STDERR "\n  usage: $0 [options] collection-name\n\n";
    4346    print STDERR "  options:\n";
     47    print STDERR "   -optionfile file    Get options from file, useful on systems where\n";
     48    print STDERR "                       long command lines may cause problems\n";
     49    print STDERR "   -collectdir         Collection to create new collection in.\n";
     50    print STDERR "                       Default is " .
     51    &util::filename_cat($ENV{'GSDLHOME'}, "collect") . "\n";
    4452    print STDERR "   -creator email      Your email address\n";
    4553    print STDERR "   -maintainer email   The current maintainer's email address\n";
    … …  
    8997    } else {
    9098        my $destfile = $file;
    91         $destfile =~ s/^\modelcol/$collection/;
    92         $destfile =~ s/^\MODELCOL/$capcollection/;
     99        $destfile =~ s/^modelcol/$collection/;
     100        $destfile =~ s/^MODELCOL/$capcollection/;
    93101        $destfile = &util::filename_cat ($coldir, $destfile);
    94102
    … …  
    123131}
    124132
    125 
    126 my (@indexes, @indexestext, @plugin);
    127 
    128133# get and check options
    129 if (!&parsargv::parse(\@ARGV,
    130                'creator/\w+\@[\w\.]+/', \$creator,
    131                'maintainer/\w+\@[\w\.]+/', \$maintainer,
    132                'public/true|false/true', \$public,
    133                'beta/true|false/true', \$beta,
    134                'index/.*/document:all', \@indexes,
    135                'indextext/\.*/Terms must appear within the same document', \@indexestext,
    136                'defaultindex/.*/document:all', \$defaultindex,
    137                'title/.+/', \$title,
    138                'about/.+/', \$about,
    139                'plugin/.+', \@plugin,
    140                'refine/.+/', \$refine
    141                )) {
    142     &print_usage();
    143     die "\n";
    144 }
    145 
    146 # load default plugins if none were on command line   
    147 if (!scalar(@plugin)) {
    148     @plugin = (ZIPPlug,GMLPlug,TEXTPlug,HTMLPlug,EMAILPlug,ArcPlug,RecPlug);
    149 }
    150 
    151 # get and check the collection name
    152 ($collection) = @ARGV;
    153 if (!defined($collection)) {
    154     print STDERR "no collection name was specified\n";
    155     &print_usage();
    156     die "\n";
    157 }
    158 
    159 if (length($collection) > 8) {
    160     print STDERR "The collection name must be less than 8 characters\n";
    161     print STDERR "so compatibility with earlier filesystems can be\n";
    162     print STDERR "maintained.\n";
    163     die "\n";
    164 }
    165 
    166 if ($collection eq "modelcol") {
    167     print STDERR "No collection can be named modelcol as this is the\n";
    168     print STDERR "name of the model collection.\n";
    169     die "\n";
    170 }
    171 
    172 if ($collection eq "CVS") {
    173     print STDERR "No collection can be named CVS as this may interfere\n";
    174     print STDERR "with directories created by the CVS versioning system\n";
    175     die "\n";
    176 }
    177 
    178 if (!defined($creator) || $creator eq "") {
    179     print STDERR "The creator was not defined. This variable is\n";
    180     print STDERR "needed to recognise duplicate collection names.\n";
    181     die "\n";
    182 }
    183 
    184 if (!defined($maintainer) || $maintainer eq "") {
    185     $maintainer = $creator;
    186 }
    187 
    188 $public = "true" unless defined $public;
    189 $beta = "true" unless defined $beta;
    190 
    191 
    192 if (!defined($title) || $title eq "") {
    193     $title = $collection;
    194 }
    195 
    196 # get capitalised version of the collection
    197 $capcollection = $collection;
    198 $capcollection =~ tr/a-z/A-Z/;
    199 
    200 
    201 # get the strings to include.
    202 $indexesstr = join ("\t", @indexes);
    203 $indexestextstr = "";
    204 for ($i=0; $i<scalar(@indexestext); $i++) {
    205     $indexestextstr .= "_$indexes[$i]_[] {$indexestext[$i]}\n";
    206 }
    207 
    208 $pluginstring = "";
    209 foreach $plugin (@plugin) {
    210     $pluginstring .= "plugin         $plugin\n";
    211 }
    212 
    213 $mdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", "modelcol");
    214 $cdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
    215 
    216 # make sure the model collection exists
    217 die "Cannot find the model collection $mdir" unless (-d $mdir);
    218 
    219 # make sure this collection does not already exist
    220 if (-e $cdir) {
    221     print STDERR "This collection already exists\n";
    222     die "\n";
    223 }
    224 
    225 
    226 # start creating the collection
    227 print STDERR "Creating the collection $collection\n";
    228 &traverse_dir ($mdir, $cdir);
    229 print STDERR "The new collection is in $cdir.\n";
    230 
    231 
     134sub parse_args {
     135    my ($argref) = @_;
     136    if (!&parsargv::parse($argref,
     137              'optionfile/.*/', \$optionfile,
     138              'collectdir/.*/', \$collectdir,
     139              'creator/\w+\@[\w\.]+/', \$creator,
     140              'maintainer/\w+\@[\w\.]+/', \$maintainer,
     141              'public/true|false/true', \$public,
     142              'beta/true|false/true', \$beta,
     143              'index/.*/document:all', \@indexes,
     144              'indextext/\.*/Terms must appear within the same document', \@indexestext,
     145              'defaultindex/.*/document:all', \$defaultindex,
     146              'title/.+/', \$title,
     147              'about/.+/', \$about,
     148              'plugin/.+', \@plugin,
     149              'refine/.+/', \$refine
     150              )) {
     151    &print_usage();
     152    die "\n";
     153    }
     154}
     155
     156sub main {
     157
     158    &parse_args (\@ARGV);
     159    if ($optionfile =~ /\w/) {
     160    open (OPTIONS, $optionfile) || die "Couldn't open $optionfile\n";
     161    my $line = [];
     162    my $options = [];
     163    while (defined ($line = &cfgread::read_cfg_line ('mkcol::OPTIONS'))) {
     164        push (@$options, @$line);
     165    }
     166    close OPTIONS;
     167    &parse_args ($options);
     168
     169    }
     170
     171    # load default plugins if none were on command line   
     172    if (!scalar(@plugin)) {
     173    @plugin = (ZIPPlug,GMLPlug,TEXTPlug,HTMLPlug,EMAILPlug,ArcPlug,RecPlug);
     174    }
     175
     176    # get and check the collection name
     177    ($collection) = @ARGV;
     178    if (!defined($collection)) {
     179    print STDERR "no collection name was specified\n";
     180    &print_usage();
     181    die "\n";
     182    }
     183
     184    if (length($collection) > 8) {
     185    print STDERR "The collection name must be less than 8 characters\n";
     186    print STDERR "so compatibility with earlier filesystems can be\n";
     187    print STDERR "maintained.\n";
     188    die "\n";
     189    }
     190
     191    if ($collection eq "modelcol") {
     192    print STDERR "No collection can be named modelcol as this is the\n";
     193    print STDERR "name of the model collection.\n";
     194    die "\n";
     195    }
     196
     197    if ($collection eq "CVS") {
     198    print STDERR "No collection can be named CVS as this may interfere\n";
     199    print STDERR "with directories created by the CVS versioning system\n";
     200    die "\n";
     201    }
     202
     203    if (!defined($creator) || $creator eq "") {
     204    print STDERR "The creator was not defined. This variable is\n";
     205    print STDERR "needed to recognise duplicate collection names.\n";
     206    die "\n";
     207    }
     208
     209    if (!defined($maintainer) || $maintainer eq "") {
     210    $maintainer = $creator;
     211    }
     212
     213    $public = "true" unless defined $public;
     214    $beta = "true" unless defined $beta;
     215
     216    if (!defined($title) || $title eq "") {
     217    $title = $collection;
     218    }
     219
     220    # get capitalised version of the collection
     221    $capcollection = $collection;
     222    $capcollection =~ tr/a-z/A-Z/;
     223
     224    # get the strings to include.
     225    $indexesstr = join ("\t", @indexes);
     226    $indexestextstr = "";
     227    for ($i=0; $i<scalar(@indexestext); $i++) {
     228    $indexestextstr .= "_$indexes[$i]_[] {$indexestext[$i]}\n";
     229    }
     230
     231    $pluginstring = "";
     232    foreach $plugin (@plugin) {
     233    $pluginstring .= "plugin         $plugin\n";
     234    }
     235
     236    $mdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", "modelcol");
     237    if (defined $collectdir && $collectdir =~ /\w/) {
     238    if (!-d $collectdir) {
     239        print STDERR "ERROR: $collectdir doesn't exist\n";
     240        die "\n";
     241    }
     242    $cdir = &util::filename_cat ($collectdir, $collection);
     243    } else {
     244    $cdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
     245    }
     246
     247    # make sure the model collection exists
     248    die "Cannot find the model collection $mdir" unless (-d $mdir);
     249
     250    # make sure this collection does not already exist
     251    if (-e $cdir) {
     252    print STDERR "This collection already exists\n";
     253    die "\n";
     254    }
     255
     256    # start creating the collection
     257    print STDERR "Creating the collection $collection\n";
     258    &traverse_dir ($mdir, $cdir);
     259    print STDERR "The new collection is in $cdir.\n";
     260}
     261
     262&main ();

  • trunk/gsdl/perllib/docsave.pm

    r1424 r1454  
    5858   
    5959    # set a default for the archive directory
    60     $self->{'archive_dir'} = "$ENV{'GSDLHOME'}/collect/$self->{'collection'}/archives";
     60    $self->{'archive_dir'} = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "archives");
    6161   
    6262    $self->{'sortmeta'} = undef;

  • trunk/gsdl/perllib/plugin.pm

    r1431 r1454  
    8080    my $rv = 0;
    8181
     82    # the .kill file is a handy (if not very elegant) way of aborting
     83    # an import.pl or buildcol.pl process
     84    if (-e &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, ".kill")) {
     85    print $outhandle "Process killed by .kill file\n";
     86    die "\n";
     87    }
     88   
    8289    # pass this file by each of the plugins in turn until one
    8390    # is found which will process it

  • trunk/gsdl/perllib/util.pm

    r1431 r1454  
    166166
    167167# recursively copies a file or group of files
    168 # syntax: cp_r (sourcefiles, destination file or directory)
     168# syntax: cp_r (sourcefiles, destination directory)
     169# destination must be a directory - to copy one file to
     170# another use cp instead
    169171sub cp_r {
    170172    my $dest = pop (@_);
    171173    my (@srcfiles) = @_;
    172174
    173     # remove trailing slashes from source and destination files
    174     $dest =~ s/[\\\/]+$//;
    175     map {$_ =~ s/[\\\/]+$//;} @srcfiles;
    176 
    177175    # a few sanity checks
    178176    if (scalar (@srcfiles) == 0) {
    179     print STDERR "util::cp no destination directory given\n";
    180     return;
    181     } elsif ((scalar (@srcfiles) > 1) && (!-d $dest)) {
    182     print STDERR "util::cp if multiple source files are given the ".
    183         "destination must be a directory\n";
     177    print STDERR "util::cp_r no destination directory given\n";
     178    return;
     179    } elsif (-f $dest) {
     180    print STDERR "util::cp_r destination must be a directory\n";
    184181    return;
    185182    }
    186183   
     184    # create destination directory if it doesn't exist already
     185    if (! -d $dest) {
     186    my $store_umask = umask(0002);
     187    mkdir ($dest, 0777);
     188    umask($store_umask);
     189    }
     190
    187191    # copy the files
    188192    foreach $file (@srcfiles) {
    189     # copy the file to within dest if dest is a directory
    190     # exception: if there is only one source file and that
    191     # source file is a directory
    192     my $tempdest = $dest;
    193     if (-d $tempdest && !(scalar(@srcfiles) == 1 && -d $file)) {
    194         my ($filename) = $file =~ /([^\\\/]+)$/;
    195         $tempdest .= "/$filename";
    196     }
    197193
    198194    if (!-e $file) {
    199         print STDERR "util::cp $file does not exist\n";
     195        print STDERR "util::cp_r $file does not exist\n";
    200196
    201197    } elsif (-d $file) {
    202         # make a new directory (if needed)
    203         unless (-e $tempdest)
    204         {
    205         my $store_umask = umask(0002);
    206         mkdir ($tempdest, 0777);
    207         umask($store_umask);
    208         }
     198        print STDERR "directory: $file\n";
    209199
    210200        # get the contents of this directory
    … …  
    212202        print STDERR "util::cp_r could not open directory $file\n";
    213203        } else {
    214         my @filedir = grep (!/^\.\.?$/, readdir (INDIR));
     204        my @filedir = readdir (INDIR);
    215205        closedir (INDIR);
    216 
    217         # copy all the files in this directory
    218         &cp_r (map {$_="$file/$_";} @filedir, $tempdest);
     206        my $olddest = $dest;
     207        foreach $f (@filedir) {
     208            next if $f =~ /^\.\.?$/;
     209            # copy all the files in this directory
     210            my $ff = &util::filename_cat ($file, $f);
     211            if (-d $ff) {
     212            # make the new directory
     213            $dest = &util::filename_cat ($dest, $f);
     214            my $store_umask = umask(0002);
     215            mkdir ($dest, 0777);
     216            umask($store_umask);
     217            }
     218            print STDERR "dest: $dest\n";
     219            &cp_r ($ff, $dest);
     220            $dest = $olddest;
     221        }
    219222        }
    220223
    221224    } else {
    222         &cp($file, $tempdest);
     225        print STDERR "ordinary file: $file --> $dest\n";
     226        &cp($file, $dest);
    223227    }
    224228    }
    … …  
    504508}
    505509
     510# returns 1 if filename1 and filename2 point to the same
     511# file or directory
     512sub filenames_equal {
     513    my ($filename1, $filename2) = @_;
     514
     515    # use filename_cat to clean up trailing slashes and
     516    # multiple slashes
     517    $filename1 = filename_cat ($filename1);
     518    $filename1 = filename_cat ($filename1);
     519
     520    # filenames not case sensitive on windows
     521    if ($ENV{'GSDLOS'} =~ /^windows$/i) {
     522    $filename1 =~ tr/[A-Z]/[a-z]/;
     523    $filename2 =~ tr/[A-Z]/[a-z]/;
     524    }
     525    return 1 if $filename1 eq $filename2;
     526    return 0;
     527}
     528
    506529sub get_os_dirsep {
    507530
    … …  
    535558# will return the collection name if successful, "" otherwise
    536559sub use_collection {
    537     my ($collection) = @_;
     560    my ($collection, $collectdir) = @_;
     561
     562    if (!defined $collectdir || $collectdir eq "") {
     563    $collectdir = &filename_cat ($ENV{'GSDLHOME'}, "collect");
     564    }
    538565
    539566    # get and check the collection
    … …  
    555582    # are defined
    556583    $ENV{'GSDLCOLLECTION'} = $collection unless defined $ENV{'GSDLCOLLECTION'};
    557     $ENV{'GSDLCOLLECTDIR'} = &filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
     584    $ENV{'GSDLCOLLECTDIR'} = &filename_cat ($collectdir, $collection);
    558585
    559586    # make sure this collection exists
Note: See TracChangeset for help on using the changeset viewer.