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

View of /trunk/webwork/system/scripts/import_permission-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: 3642 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_permission-database.pl courseID textDatabaseFile\n";
   25    print "      (e.g. import_permission-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 my $perm_file = &Global::getCoursePermissionsFile($course);
   41 
   42 # File names
   43 
   44   require "${courseScriptsDirectory}$Global::DBglue_pl";
   45   require "${courseScriptsDirectory}$Global::HTMLglue_pl";
   46   require "${courseScriptsDirectory}$Global::FILE_pl";
   47 
   48 
   49 
   50 # get all psvn's for set
   51 
   52 my ($line);
   53 
   54 my @permission_array = ();
   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 @permission_array, $1;}
   63 
   64     else {                                  ## bracketed line
   65         $line =~ /^\[(.*)\]$/;
   66         push @permission_array, $1;
   67     }
   68 }
   69 
   70 close (INFILE);
   71 
   72 ## backup existing db
   73 
   74 my $message = '';
   75 
   76 if ( -e "$perm_file" ) {
   77 #   $message .= "Backing up current webwork data base: $perm_file\n Two backups are kept.\n\n";
   78 print "Backing up current webwork data base: $perm_file\n Two backups are kept.\n\n";
   79     &backup($perm_file);
   80   }
   81 
   82 ## Create new database
   83 
   84 
   85 #$message .= "Creating new data base $perm_file .\n";
   86 print "Creating new data base $perm_file .\n";
   87 
   88 create_db($perm_file, $Global::webwork_database_permission);
   89 
   90 if ( -e $perm_file ) {
   91   chmod($Global::webwork_database_permission,$perm_file) ||
   92          wwerror($0, "Can't do chmod($Global::webwork_database_permission,$perm_file)");
   93   chown(-1,$Global::numericalGroupID,$perm_file)  ||
   94          wwerror($0,"Can't do chown(-1,$Global::numericalGroupID,$perm_file)");
   95 
   96 # $message .=   "New data base created\n";
   97 print "New (blank) data base created\n";
   98 }
   99 else {
  100 # $message .=   "New data base could not be created\n";
  101 print "New data base could not be created\n";
  102 }
  103 
  104 # load up new database
  105 my $wwDbObj;            # Object for referencing the database
  106 my %hash;
  107 
  108 &Global::tie_hash('PER_FH', \$wwDbObj, \%hash, $perm_file, 'W', $Global::standard_tie_permission);
  109 %hash = @permission_array;
  110 &Global::untie_hash('PER_FH', \$wwDbObj, \%hash, $perm_file);
  111 
  112 # $message .=   "The new data base $perm_file could not be created\n";
  113 print "The new data base $perm_file has been filled with data\n";
  114 
  115 sub backup  {
  116   ## takes as a parameter the full path name
  117   ## makes upto two backups of the file with _bak1, or _bak2
  118   ## appended to filename where _bak1 is the most recent backup
  119 
  120   my $fileName =$_[0];
  121 
  122   if (-e "${fileName}_bak1") {
  123     rename("${fileName}_bak1","${fileName}_bak2") or
  124       &wwerror("$0","can't rename ${fileName}_bak1");
  125   }
  126 
  127   if (-e "${fileName}") {
  128     rename("${fileName}","${fileName}_bak1") or
  129       &wwerror("$0","can't rename ${fileName}");
  130   }
  131 }

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9