View of /trunk/webwork/system/scripts/import_webwork-database.pl

    1 #!/usr/local/bin/webwork-perl
    2 
    3 ####################################################################
    4 # Copyright @ 1995-1999 University of Rochester
    5 # All Rights Reserved
    6 ####################################################################
    7 
    8 BEGIN {
    9   my $useLibDir = '.';
   10   if    ($0 =~ m|^(/.*)/|)  { $useLibDir = $1; }
   11   elsif ($0 =~ m|^(\..*)/|) { $useLibDir = $1; }
   12   elsif ($0 =~ m|^(.+)/|)   { $useLibDir = "./$1"; }
   13   unshift @INC, $useLibDir;
   14 }
   15 
   16 use webworkInit; # WeBWorKInitLine
   17 
   18 # Called as
   19 # showDatabase.pl courseID
   20 
   21 use Global;
   22 use Auth;
   23 use strict;
   24 use GDBM_File;
   25 
   26 if (@ARGV != 2)
   27   {
   28    print "\nSyntax is import_webwork-database.pl courseID textDatabaseFile\n";
   29    print "      (e.g. import_webwork-database.pl  demoCourse textDataBase)\n\n";
   30    exit(0);
   31   }
   32 
   33 my $course = $ARGV[0];
   34 my $textDatabaseFile = $ARGV[1];
   35 
   36 # establish environment for this script
   37 
   38   &Global::getCourseEnvironment($course);
   39 
   40 # Directory paths
   41 
   42 my $databaseDirectory = getCourseDatabaseDirectory();
   43 my $courseScriptsDirectory = getWebworkScriptDirectory();
   44 
   45 # File names
   46 
   47   require "${courseScriptsDirectory}$Global::DBglue_pl";
   48   require "${courseScriptsDirectory}$Global::HTMLglue_pl";
   49   require "${courseScriptsDirectory}$Global::FILE_pl";
   50 
   51   my $databaseFile = $Global::database;
   52 
   53 # get all psvn's for set
   54 
   55 my ($line,$item);
   56 my @probSetRecord = ();
   57 my $probSetString = '';
   58 my @PROBSETarray = ();
   59 
   60 open (INFILE, "$textDatabaseFile") or wwerror("$0","can't open $textDatabaseFile for reading");
   61 
   62 while (defined ($line = <INFILE>)) {
   63     chomp($line);
   64     unless ($line =~ /\S/) {next;}          ## skip blank lines
   65     if ($line =~ /^[^\[]\s*(.*)/) {         ## non bracketed line
   66         push @probSetRecord, $1;}
   67 
   68     else {                                  ## bracketed line
   69         $probSetString = join ("\&", @probSetRecord);
   70         push @PROBSETarray, $probSetString;
   71         $line =~ /^\[(.*)\]$/;
   72         push @PROBSETarray, $1;
   73         @probSetRecord =();
   74     }
   75 }
   76 
   77 close (INFILE);
   78 
   79 $probSetString = join ("\&", @probSetRecord); ## last record
   80 push @PROBSETarray, $probSetString; ## add last record
   81 shift @PROBSETarray;                ## remove first item which is an empty probSetString
   82 
   83 my $mode = &GDBM_WRCREAT();
   84 my $permission = $Global::standard_tie_permission;
   85 my $db;
   86 my %hash;
   87 
   88 $db = tie(%hash, "GDBM_File", "${databaseDirectory}${databaseFile}", $mode, $permission);
   89 %hash = @PROBSETarray;
   90 $db->reorganize();
   91 untie($db);
   92 chmod($permission,"${databaseDirectory}${databaseFile}") or
   93           warn("compress_GDBM_webwork-database.pl: error", " Can't do chmod($permission, ${databaseDirectory}${databaseFile})");
   94 
   95