[system] / trunk / webwork / system / scripts / import_webwork-database.pl Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 292 - (download) (as text) (annotate)
Thu May 23 13:51:21 2002 UTC (17 years, 6 months ago) by gage
File size: 4121 byte(s)
Updating perl command line to
#!/usr/local/bin/webwork-perl

    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 use Global;
   19 use Auth;
   20 use strict;
   21 
   22 if (@ARGV != 2)
   23   {
   24    print "\nSyntax is import_webwork-database.pl courseID textDatabaseFile\n";
   25    print "      (e.g. import_webwork-database.pl  demoCourse textDataBase)\n\n";
   26    exit(0);
   27   }
   28 
   29 my $course = $ARGV[0];
   30 my $textDatabaseFile = $ARGV[1];
   31 
   32 # establish environment for this script
   33 
   34   &Global::getCourseEnvironment($course);
   35 
   36 # Directory paths
   37 
   38 my $databaseDirectory = getCourseDatabaseDirectory();
   39 my $courseScriptsDirectory = getWebworkScriptDirectory();
   40 
   41 # File names
   42 
   43   require "${courseScriptsDirectory}$Global::DBglue_pl";
   44   require "${courseScriptsDirectory}$Global::HTMLglue_pl";
   45   require "${courseScriptsDirectory}$Global::FILE_pl";
   46 
   47   my $databaseFile = $Global::database;
   48 
   49 # get all psvn's for set
   50 
   51 my ($line,$item);
   52 my @probSetRecord = ();
   53 my $probSetString = '';
   54 my @PROBSETarray = ();
   55 
   56 open (INFILE, "$textDatabaseFile") or wwerror("$0","can't open $textDatabaseFile for reading");
   57 
   58 while (defined ($line = <INFILE>)) {
   59     chomp($line);
   60     unless ($line =~ /\S/) {next;}          ## skip blank lines
   61     if ($line =~ /^[^\[]\s*(.*)/) {         ## non bracketed line
   62         push @probSetRecord, $1;}
   63 
   64     else {                                  ## bracketed line
   65         $probSetString = join ("\&", @probSetRecord);
   66         push @PROBSETarray, $probSetString;
   67         $line =~ /^\[(.*)\]$/;
   68         push @PROBSETarray, $1;
   69         @probSetRecord =();
   70     }
   71 }
   72 
   73 close (INFILE);
   74 
   75 $probSetString = join ("\&", @probSetRecord); ## last record
   76 push @PROBSETarray, $probSetString; ## add last record
   77 shift @PROBSETarray;                ## remove first item which is an empty probSetString
   78 
   79 my $path_to_WW_DB = "${databaseDirectory}$Global::database";
   80 
   81 ## backup existing db
   82 
   83 my $message = '';
   84 
   85 if ( -e "$path_to_WW_DB" ) {
   86 #   $message .= "Backing up current webwork data base: $path_to_WW_DB\n Two backups are kept.\n\n";
   87 print "Backing up current webwork data base: $path_to_WW_DB\n Two backups are kept.\n\n";
   88     &backup($path_to_WW_DB);
   89   }
   90 
   91 ## Create new database
   92 
   93 
   94 #$message .= "Creating new data base $path_to_WW_DB .\n";
   95 print "Creating new data base $path_to_WW_DB .\n";
   96 
   97 create_db($path_to_WW_DB, $Global::webwork_database_permission);
   98 
   99 if ( -e $path_to_WW_DB ) {
  100   chmod($Global::webwork_database_permission,$path_to_WW_DB) ||
  101          wwerror($0, "Can't do chmod($Global::webwork_database_permission,$path_to_WW_DB)");
  102   chown(-1,$Global::numericalGroupID,$path_to_WW_DB)  ||
  103          wwerror($0,"Can't do chown(-1,$Global::numericalGroupID,$path_to_WW_DB)");
  104 
  105 # $message .=   "New data base created\n";
  106 print "New (blank) data base created\n";
  107 }
  108 else {
  109 # $message .=   "New data base could not be created\n";
  110 print "New data base could not be created\n";
  111 }
  112 
  113 # load up new database
  114 my $wwDbObj;            # Object for referencing the database
  115 my %hash;
  116 
  117 &Global::tie_hash('WW_FH', \$wwDbObj, \%hash, $path_to_WW_DB, 'W', $Global::standard_tie_permission);
  118 %hash = @PROBSETarray;
  119 &Global::untie_hash('WW_FH', \$wwDbObj, \%hash, $path_to_WW_DB);
  120 
  121 # $message .=   "The new data base $path_to_WW_DB could not be created\n";
  122 print "The new data base $path_to_WW_DB has been filled with data\n";
  123 
  124 sub backup  {
  125   ## takes as a parameter the full path name
  126   ## makes upto two backups of the file with _bak1, or _bak2
  127   ## appended to filename where _bak1 is the most recent backup
  128 
  129   my $fileName =$_[0];
  130 
  131   if (-e "${fileName}_bak1") {
  132     rename("${fileName}_bak1","${fileName}_bak2") or
  133       &wwerror("$0","can't rename ${fileName}_bak1");
  134   }
  135 
  136   if (-e "${fileName}") {
  137     rename("${fileName}","${fileName}_bak1") or
  138       &wwerror("$0","can't rename ${fileName}");
  139   }
  140 }

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9