Return to update_queue_slots.piml CVS log

Up to [LON-CAPA] / doc / loncapafiles

- adding piml for updating the slto definitions and queue entries between 2.1 and 2.2

    1: <!DOCTYPE piml PUBLIC "-//TUX/DTD piml 1.0 Final//EN" 
    2: 	"http://lpml.sourceforge.net/DTD/piml.dtd">
    3: <!-- accesscount_seed.piml -->
    4: <!-- Matthew Hall -->
    5: 
    6: <!-- $Id: update_queue_slots.piml,v 1.1 2006/06/05 23:18:45 albertel Exp $ -->
    7: 
    8: <!--
    9: 
   10: This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   11: 
   12: LON-CAPA is free software; you can redistribute it and/or modify
   13: it under the terms of the GNU General Public License as published by
   14: the Free Software Foundation; either version 2 of the License, or
   15: (at your option) any later version.
   16: 
   17: LON-CAPA is distributed in the hope that it will be useful,
   18: but WITHOUT ANY WARRANTY; without even the implied warranty of
   19: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   20: GNU General Public License for more details.
   21: 
   22: You should have received a copy of the GNU General Public License
   23: along with LON-CAPA; if not, write to the Free Software
   24: Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   25: 
   26: /home/httpd/html/adm/gpl.txt
   27: 
   28: http://www.lon-capa.org/
   29: 
   30: -->
   31: 
   32: <piml>
   33: <targetroot>/</targetroot>
   34: <files>
   35: <file>
   36: <target dist="default">/home/httpd/lonUsers</target>
   37: <perlscript mode="fg">
   38: use strict;
   39: use File::Find;
   40: use lib '/home/httpd/lib/perl/';
   41: use LONCAPA::Configuration;
   42: use LONCAPA;
   43: use GDBM_File;
   44: use Storable;
   45: use Apache::lonnet;
   46: 
   47: $|=1;
   48: 
   49: sub update_value {
   50:     my ($value) = @_;
   51:     if ($value =~ /@/ &amp;&amp; $value !~ /:/) {
   52: 	$value =~ tr/@/:/;
   53:     }
   54:     return $value;
   55: }
   56: 
   57: my $updated;
   58: sub process_gradingqueue_file {
   59:     return if ($_!~m/(gradingqueue|reviewqueue|slots|slot_reservations)\.db$/);
   60:     my $type='queue';
   61:     if ($1 eq 'slots') {
   62: 	$type = 'slots';
   63:     } elsif ($1 eq 'slot_reservations') {
   64: 	$type = 'reservation';
   65:     }
   66:     my $count = length("$updated");
   67:     $updated++;
   68:     print("\b"x(14+$count));
   69:     print("Updated $updated files");
   70:     my $prefix = $_;
   71:     $prefix =~s/\.db$//;
   72:     my $db = &amp;LONCAPA::_locking_hash_tie($prefix,'nohist_',&amp;GDBM_WRCREAT());
   73:     if ($type eq 'queue') {
   74: 	foreach my $key (keys(%{$db})) {
   75: 	    my $real_key = &amp;unescape($key);
   76: 	    my (@elements) = split("\0",$real_key);
   77: 	    if (exists($elements[2])) {
   78: 		$elements[2] = &amp;update_value($elements[2]);
   79: 	    }
   80: 	    $real_key = join("\0",@elements);
   81: 	    my $new_key = &amp;escape($real_key);
   82: 	    if ($new_key ne $key) {
   83: 		$db-&gt;{$new_key} = $db-&gt;{$key};
   84: 		delete($db-&gt;{$key});
   85: 	    }
   86: 	    if ($new_key =~ /locked$/) {
   87: 		my $value = $db-&gt;{$new_key};
   88: 		my $new_value = &amp;unescape($value);
   89: 		$new_value = &amp;update_value($new_value);
   90: 		$db-&gt;{$new_key} = &amp;escape($new_value);
   91: 	    }
   92: 	}
   93:     } elsif ($type eq 'slots') {
   94: 	foreach my $key (keys(%{$db})) {
   95: 	    my $value = $db-&gt;{$key};
   96: 	    $value = &amp;Apache::lonnet::thaw_unescape($value);
   97: 	    if (exists($value-&gt;{'proctor'})) {
   98: 		$value-&gt;{'proctor'} = &amp;update_value($value-&gt;{'proctor'});
   99: 	    }
  100: 	    if (exists($value-&gt;{'allowedusers'})) {
  101: 		$value-&gt;{'allowedusers'} = 
  102: 		    &amp;update_value($value-&gt;{'allowedusers'});
  103: 	    }
  104: 	    $db-&gt;{$key} = &amp;Apache::lonnet::freeze_escape($value);
  105: 	}
  106:     } elsif ($type eq 'reservation') {
  107: 	foreach my $key (keys(%{$db})) {
  108: 	    my $value = $db-&gt;{$key};
  109: 	    $value = &amp;Apache::lonnet::thaw_unescape($value);
  110: 	    if (exists($value-&gt;{'name'})) {
  111: 		$value-&gt;{'name'} = &amp;update_value($value-&gt;{'name'});
  112: 	    }
  113: 	    $db-&gt;{$key} = &amp;Apache::lonnet::freeze_escape($value);
  114: 	}   
  115:     } else {
  116: 	print("$type unsupported\n");
  117:     }
  118:     &amp;untie_user_hash($db);
  119: 
  120: }
  121: 
  122: 
  123: sub main {
  124:      print("Updating grading queue and slot definitions\n");
  125:      my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
  126:      find(
  127:          {
  128: 	     no_chdir   =&gt; 1,
  129: 	     wanted     =&gt; \&amp;process_gradingqueue_file,
  130: 	 }, 
  131:          '/home/www/lonUsers/');
  132:      print("\n");
  133: }
  134: 
  135: &amp;main();
  136: 
  137: </perlscript>
  138: </file>
  139: </files>
  140: </piml>