Changeset 1424 for trunk/gsdl/bin/script


Ignore:
Timestamp:
2000-08-18T17:37:15+12:00 (24 years ago)
Author:
sjboddie
Message:

Added a -out option to most of the perl building scripts to allow output
debug information to be directed to a file.

Location:
trunk/gsdl/bin/script
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/gsdl/bin/script/build

    r1277 r1424  
    1515use parsargv;
    1616use util;
    17 
     17use FileHandle;
    1818
    1919if (!parsargv::parse(\@ARGV,
     20             'remove_archives', \$remove_archives,
     21             'remove_import', \$remove_import,
    2022             'buildtype/^(build|import)$/import', \$buildtype,
    21              'maxdocs/^\-?\d+/-1', \$maxdocs)) {
     23             'maxdocs/^\-?\d+/-1', \$maxdocs,
     24             'download/.+', \@download,
     25             'out/.*/STDERR', \$out)) {
     26   
    2227    &print_usage();
    2328    die "\n";
    … …  
    3742    $maxdocs = "-maxdocs $maxdocs";
    3843}
    39 
    4044
    4145my $collectdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
    … …  
    4650my $bindir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin");
    4751
     52my $close_out = 0;
     53my $outfile = $out;
     54if ($out !~ /^(STDERR|STDOUT)$/i) {
     55    open (OUT, ">$out") || die "Couldn't open output file $out\n";
     56    $out = "OUT";
     57    $close_out = 1;
     58}
     59$out->autoflush(1);
     60
    4861&main();
     62
     63close OUT if $close_out;
    4964
    5065sub print_usage {
    5166    print STDERR "\n  usage: $0 [options] collection-name\n\n";
    5267    print STDERR "  options:\n";
     68    print STDERR "   -remove_archives        Remove archives directory after successfully\n";
     69    print STDERR "                           building the collection.\n";
     70    print STDERR "   -remove_import          Remove import directory after successfully\n";
     71    print STDERR "                           importing the collection.\n";
    5372    print STDERR "   -buildtype build|import If 'build' attempt to build directly\n";
    5473    print STDERR "                           from archives directory (bypassing import\n";
    5574    print STDERR "                           stage). Defaults to 'import'\n";
    56     print STDERR "   -maxdocs number         Maximum number of documents to build\n\n";
     75    print STDERR "   -maxdocs number         Maximum number of documents to build\n";
     76    print STDERR "   -download directory     Directory (or file) to get import documents from.\n";
     77    print STDERR "                           There may be multiple download directories and they\n";
     78    print STDERR "                           may be of type http://, ftp://, or file://\n.";
     79    print STDERR "                           Note that any existing import directory will be\n";
     80    print STDERR "                           deleted to make way for the downloaded data if\n";
     81    print STDERR "                           a -download option is supplied\n";
     82    print STDERR "   -out                    Filename or handle to print output status to.\n";
     83    print STDERR "                           The default is STDERR\n\n";
    5784}
    5885
    5986sub main {
     87   
     88    # do the download thing if we have any -download options
     89    if (scalar (@download)) {
     90    # remove any existing import data
     91    &util::rm_r ($importdir) if -d $importdir;
     92
     93    foreach $download_dir (@download) {
     94       
     95        if ($download_dir =~ /^http:\/\//) {
     96        # http download
     97
     98        } elsif ($download_dir =~ /^ftp:\/\//) {
     99        # ftp download
     100
     101        } else {
     102        # we assume anything not beginning with http:// or ftp://
     103        # is a file or directory on the local file system.
     104        $download_dir =~ s/^file:\/\///;
     105       
     106        if (-e $download_dir) {
     107            # copy download_dir and all it contains to the import directory
     108            my $download_cmd = "perl " . &util::filename_cat ($bindir, "script", "filecopy.pl");
     109            $download_cmd .= " -out \"$outfile\" \"" . $download_dir . "\" " . $collection;
     110            system ($download_cmd);
     111        } else {
     112            print $out "WARNING: $download_dir does not exist\n";
     113        }
     114        }
     115    }
     116    }
    60117
    61118    if (-e &util::filename_cat ($archivedir, "archives.inf")) {
    … …  
    69126    } else {
    70127        # there are archives but no import, build directly from archives
    71         print STDERR "build: no import material was found, building directly\n";
    72         print STDERR "       from archives\n";
     128        print $out "build: no import material was found, building directly\n";
     129        print $out "       from archives\n";
    73130        &gsdl_build();
    74131    }
    … …  
    76133    if (&has_content ($importdir)) {
    77134        if ($buildtype eq "build") {
    78         print STDERR "build: can't build directly from archives as no\n";
    79         print STDERR "       imported archives exist (did you forget to\n";
    80         print STDERR "       move the contents of $collection/import to\n";
    81         print STDERR "       collection/archives?)\n";
     135        print $out "build: can't build directly from archives as no\n";
     136        print $out "       imported archives exist (did you forget to\n";
     137        print $out "       move the contents of $collection/import to\n";
     138        print $out "       collection/archives?)\n";
    82139        }
    83140        &gsdl_import();
    … …  
    85142    } else {
    86143        # no import or archives
    87         print STDERR "build: ERROR: The $collection collection has no import\n";
    88         print STDERR "       or archives data. Try downloading an unbuilt version\n";
    89         print STDERR "       of the collection from www.nzdl.org\n";
     144        print $out "build: ERROR: The $collection collection has no import\n";
     145        print $out "       or archives data. Try downloading an unbuilt version\n";
     146        print $out "       of the collection from www.nzdl.org\n";
    90147        die "\n";
    91148    }
    … …  
    95152sub gsdl_import {
    96153
    97     print STDERR "importing the $collection collection\n\n";
     154    print $out "importing the $collection collection\n\n";
    98155
    99156    my $import = &util::filename_cat ($bindir, "script", "import.pl");
    100     system ("perl $import -removeold $maxdocs $collection");
     157    system ("perl $import -removeold $maxdocs -out \"$outfile\" $collection");
    101158    if (-e &util::filename_cat ($archivedir, "archives.inf")) {
    102     print STDERR "$collection collection imported successfully\n\n";
     159    print $out "$collection collection imported successfully\n\n";
     160    if ($remove_import) {
     161        print $out "removing import directory ($importdir)\n";
     162        &util::rm_r ($importdir);
     163    }
    103164    } else {
    104165    die "\nimport.pl failed\n";
    … …  
    108169sub gsdl_build {
    109170
    110     print STDERR "building the $collection collection\n\n";
     171    print $out "building the $collection collection\n\n";
    111172
    112173    my $buildcol = &util::filename_cat ($bindir, "script", "buildcol.pl");
    113     system ("perl $buildcol $maxdocs $collection");
     174    system ("perl $buildcol $maxdocs -out \"$outfile\" $collection");
    114175    if (-e &util::filename_cat ($buildingdir, "text", "$collection.ldb") ||
    115176    -e &util::filename_cat ($buildingdir, "text", "$collection.bdb")) {
    116     print STDERR "$collection collection built successfully\n\n";
     177    print $out "$collection collection built successfully\n\n";
     178    if ($remove_archives) {
     179        print $out "removing archives directory ($archivedir)\n";
     180        &util::rm_r ($archivedir);
     181    }
    117182    } else {
    118183    die "\nbuildcol.pl failed\n";
    … …  
    121186    # replace old indexes with new ones
    122187    if (&has_content ($indexdir)) {
    123     print STDERR "removing old indexes\n";
     188    print $out "removing old indexes\n";
    124189    &util::rm_r ($indexdir);
    125190    }

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

    r1383 r1424  
    2525#
    2626###########################################################################
     27
     28package buildcol;
    2729
    2830BEGIN {
    … …  
    3739use parsargv;
    3840use util;
     41use FileHandle;
    3942
    4043&main();
    … …  
    5861    print STDERR "                         collection. This relies on the Gimp being\n";
    5962    print STDERR "                         installed along with relevant perl modules\n";
    60     print STDERR "                         to allow scripting from perl\n\n";
     63    print STDERR "                         to allow scripting from perl\n";
     64    print STDERR "   -out                  Filename or handle to print output status to.\n";
     65    print STDERR "                         The default is STDERR\n\n";
    6166}
    6267
    … …  
    6671    my ($verbosity, $archivedir, $cachedir, $builddir, $maxdocs,
    6772    $debug, $mode, $indexname, $keepold, $allclassifications,
    68     $create_images);
     73    $create_images, $out);
    6974    if (!parsargv::parse(\@ARGV,
    7075             'verbosity/\d+/2', \$verbosity,
    … …  
    7883             'keepold', \$keepold,
    7984             'allclassifications', \$allclassifications,
    80              'create_images', \$create_images)) {
     85             'create_images', \$create_images,
     86             'out/.*/STDERR', \$out)) {
    8187    &print_usage();
    8288    die "\n";
    8389    }
     90
     91    my $close_out = 0;
     92    if ($out !~ /^(STDERR|STDOUT)$/i) {
     93    open (OUT, ">>$out") || die "Couldn't open output file $out\n";
     94    $out = "buildcol::OUT";
     95    $close_out = 1;
     96    }
     97    $out->autoflush(1);
    8498
    8599    # get and check the collection
    … …  
    127141    # update the archive cache if needed
    128142    if ($cachedir) {
    129     print STDERR "Updating archive cache\n" if ($verbosity >= 1);
     143    print $out "Updating archive cache\n" if ($verbosity >= 1);
    130144
    131145    $cachedir =~ s/[\\\/]+$//;
    … …  
    162176    eval("\$builder = new $buildertype(\$collection, " .
    163177     "\$realarchivedir, \$realbuilddir, \$verbosity, " .
    164      "\$maxdocs, \$debug, \$keepold, \$allclassifications)");
     178     "\$maxdocs, \$debug, \$keepold, \$allclassifications, \$out)");
    165179    die "$@" if $@;
    166180
    … …  
    186200   
    187201    if (($realbuilddir ne $builddir) && !$debug) {
    188     print STDERR "Copying back the cached build\n" if ($verbosity >= 1);
     202    print $out "Copying back the cached build\n" if ($verbosity >= 1);
    189203    &util::rm_r ($builddir);
    190204    &util::cp_r ($realbuilddir, $builddir);
    191205    }
     206
     207    close OUT if $close_out;
    192208}
    193209
    … …  
    197213    my $image_script = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "script", "gimp", "title_icon.pl");
    198214    if (!-e $image_script) {
    199     print STDERR "WARNING: Image making script ($image_script) could not be found\n";
    200     print STDERR "         Default images will not be generated\n\n";
     215    print $out "WARNING: Image making script ($image_script) could not be found\n";
     216    print $out "         Default images will not be generated\n\n";
    201217    return;
    202218    }
    … …  
    213229    # to be changed when the config file format changes)
    214230    if (!open (CFGFILE, $configfilename)) {
    215     print STDERR "WARNING: Couldn't open config file ($configfilename)\n";
    216     print STDERR "         for updating so collection images may not be linked correctly\n";
     231    print $out "WARNING: Couldn't open config file ($configfilename)\n";
     232    print $out "         for updating so collection images may not be linked correctly\n";
    217233    return;
    218234    }
    … …  
    236252
    237253    if (!open (CFGFILE, ">$configfilename")) {
    238     print STDERR "WARNING: Couldn't open config file ($configfilename)\n";
    239     print STDERR "         for updating so collection images may not be linked correctly\n";
     254    print $out "WARNING: Couldn't open config file ($configfilename)\n";
     255    print $out "         for updating so collection images may not be linked correctly\n";
    240256    return;
    241257    }

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

    r1179 r1424  
    3535
    3636use util;
     37use parsargv;
    3738use File::stat;
     39use FileHandle;
    3840
    39 sub print_usage
    40 {
    41     print STDERR "\n  usage: $0 [filenames] [directories] collection-name\n\n";
     41sub print_usage {
     42    print STDERR "\n  usage: $0 [options] [directories] collection-name\n\n";
     43
     44    print STDERR "  options:\n";
     45    print STDERR "   -out                  Filename or handle to print output status to.\n";
     46    print STDERR "                         The default is STDERR\n\n";
    4247}
    43 
    4448
    4549sub download_files
    … …  
    7074    else
    7175    {
    72         print STDERR "Error: filename '$a' does not exist\n";
     76        print $out "Error: filename '$a' does not exist\n";
    7377    }
    7478    }
    … …  
    101105        if ($do_copy eq "yes")
    102106        {
    103         print STDOUT "Copying $src_file-->$dst_file\n";
     107        print $out "Copying $src_file-->$dst_file\n";
    104108        &util::cp($src_file,$dst_file);
    105109        }
    … …  
    124128            if (!opendir (INDIR, $d))
    125129        {
    126                 print STDERR "Error: Could not open directory $d\n";
     130                print $out "Error: Could not open directory $d\n";
    127131            }
    128132        else
    … …  
    140144sub main
    141145{
    142     if (scalar(@ARGV)<2)
    143     {
    144     print_usage();
    145     exit(1);
     146    if (!parsargv::parse(\@ARGV, 'out/.*/STDERR', \$out)) {
     147    &print_usage();
     148    die "\n";
    146149    }
    147150
     151    my $close_out = 0;
     152    if ($out !~ /^(STDERR|STDOUT)$/i) {
     153    open (OUT, ">>$out") || die "Couldn't open output file $out\n";
     154    $out = "MAIN::OUT";
     155    $close_out = 1;
     156    }
     157    $out->autoflush(1);
     158
    148159    download_files(@ARGV);
     160
     161    close OUT if $close_out;
    149162    return 0;
    150163}

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

    r1287 r1424  
    2828
    2929# This program will import a number of files into a particular collection
     30
     31package import;
    3032
    3133BEGIN {
    … …  
    3739}
    3840
    39 use strict;
    4041use arcinfo;
    4142use colcfg;
    … …  
    4445use util;
    4546use parsargv;
     47use FileHandle;
    4648
    4749sub print_usage {
    … …  
    6264    print STDERR "   -sortmeta metadata     Sort documents alphabetically by metadata for\n";
    6365    print STDERR "                          building. This will be disabled if groupsize > 1\n";
    64     print STDERR "   -debug                 Print imported text to STDOUT\n\n";
     66    print STDERR "   -debug                 Print imported text to STDOUT\n";
     67    print STDERR "   -out                   Filename or handle to print output status to.\n";
     68    print STDERR "                          The default is STDERR\n\n";
    6569}
    6670
    67 
    68 &main ();
     71&main();
    6972
    7073sub main {
    … …  
    7275    $removeold, $gzip, $groupsize, $debug, $maxdocs, $collection,
    7376    $configfilename, $collectcfg, $pluginfo, $sortmeta,
    74     $archive_info_filename, $archive_info, $processor);
     77    $archive_info_filename, $archive_info, $processor, $out);
    7578    if (!parsargv::parse(\@ARGV,
    7679             'verbosity/\d+/2', \$verbosity,
    … …  
    8386             'sortmeta/.*/', \$sortmeta,
    8487             'debug', \$debug,
    85              'maxdocs/^\-?\d+/-1', \$maxdocs)) {
     88             'maxdocs/^\-?\d+/-1', \$maxdocs,
     89             'out/.*/STDERR', \$out)) {
    8690    &print_usage();
    8791    die "\n";
    8892    }
     93
     94    my $close_out = 0;
     95    if ($out !~ /^(STDERR|STDOUT)$/i) {
     96    open (OUT, ">>$out") || die "Couldn't open output file $out\n";
     97    $out = 'import::OUT';
     98    $close_out = 1;
     99    }
     100    $out->autoflush(1);
    89101
    90102    # set removeold to false if it has been defined
    … …  
    100112    $sortmeta = undef unless defined $sortmeta && $sortmeta =~ /\S/;
    101113    if (defined $sortmeta && $groupsize > 1) {
    102     print STDERR "WARNING: import.pl cannot sort documents when groupsize > 1\n";
    103     print STDERR "         sortmeta option will be ignored\n\n";
     114    print $out "WARNING: import.pl cannot sort documents when groupsize > 1\n";
     115    print $out "         sortmeta option will be ignored\n\n";
    104116    $sortmeta = undef;
    105117    }
    … …  
    148160
    149161    # load all the plugins
    150     $pluginfo = &plugin::load_plugins ($plugins, $verbosity);
     162    $pluginfo = &plugin::load_plugins ($plugins, $verbosity, $out);
    151163    if (scalar(@$pluginfo) == 0) {
    152     print STDERR "No plugins were loaded.\n";
     164    print $out "No plugins were loaded.\n";
    153165    die "\n";
    154166    }
    … …  
    156168    # remove the old contents of the archives directory if needed
    157169    if ($removeold && -e $archivedir) {
    158     print STDERR "Warning - removing current contents of the archives directory\n";
    159     print STDERR "          in preparation for the import\n";
     170    print $out "Warning - removing current contents of the archives directory\n";
     171    print $out "          in preparation for the import\n";
    160172    sleep(5); # just in case...
    161173    &util::rm_r ($archivedir);
    … …  
    169181
    170182    # create a docsave object to process the documents
    171     $processor = new docsave ($collection, $archive_info, $verbosity, $gzip, $groupsize);
     183    $processor = new docsave ($collection, $archive_info, $verbosity, $gzip, $groupsize, $out);
    172184    $processor->setarchivedir ($archivedir);
    173185    $processor->set_sortmeta ($sortmeta) if defined $sortmeta;
    … …  
    188200    $archive_info->save_info($archive_info_filename);
    189201    }
     202    close OUT if $close_out;
    190203}
    191 
    192 
    193 
    194 
    195 
Note: See TracChangeset for help on using the changeset viewer.