Annotation of doc/loncapafiles/update_queue_slots.piml, revision 1.4

1.1       albertel    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: 
1.4     ! albertel    6: <!-- $Id: update_queue_slots.piml,v 1.3 2006/06/27 14:26:37 albertel Exp $ -->
1.1       albertel    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: 
1.2       albertel   57: my $updated=0;
                     58: my %dirs;
                     59: my $last;
                     60: my $total;
1.1       albertel   61: sub process_gradingqueue_file {
1.2       albertel   62:     my $which = (split('/',$_))[5];
                     63:     $dirs{$which} = 1;
                     64:     my $count2 = length("$last");
                     65:     my $count = length("$updated");
                     66:     my $backup = "\b"x(8+$count2+14+$count+6);
                     67:     if (scalar(keys(%dirs)) > $last) {
                     68:          $last = scalar(keys(%dirs));
                     69:          print($backup."Updated $last directories, $updated files");
                     70:     }
1.1       albertel   71:     return if ($_!~m/(gradingqueue|reviewqueue|slots|slot_reservations)\.db$/);
                     72:     my $type='queue';
                     73:     if ($1 eq 'slots') {
                     74: 	$type = 'slots';
                     75:     } elsif ($1 eq 'slot_reservations') {
                     76: 	$type = 'reservation';
                     77:     }
1.2       albertel   78:     my $count2 = length("$last");
1.1       albertel   79:     my $count = length("$updated");
1.2       albertel   80:     my $backup = "\b"x(8+$count2+14+$count+6);
1.1       albertel   81:     $updated++;
1.2       albertel   82:     print($backup."Updated $last directories, $updated files");
1.4     ! albertel   83:     my $db = &amp;LONCAPA::locking_hash_tie($_,&amp;GDBM_WRCREAT());
1.1       albertel   84:     if ($type eq 'queue') {
                     85: 	foreach my $key (keys(%{$db})) {
                     86: 	    my $real_key = &amp;unescape($key);
                     87: 	    my (@elements) = split("\0",$real_key);
                     88: 	    if (exists($elements[2])) {
                     89: 		$elements[2] = &amp;update_value($elements[2]);
                     90: 	    }
                     91: 	    $real_key = join("\0",@elements);
                     92: 	    my $new_key = &amp;escape($real_key);
                     93: 	    if ($new_key ne $key) {
                     94: 		$db-&gt;{$new_key} = $db-&gt;{$key};
                     95: 		delete($db-&gt;{$key});
                     96: 	    }
                     97: 	    if ($new_key =~ /locked$/) {
                     98: 		my $value = $db-&gt;{$new_key};
                     99: 		my $new_value = &amp;unescape($value);
                    100: 		$new_value = &amp;update_value($new_value);
                    101: 		$db-&gt;{$new_key} = &amp;escape($new_value);
                    102: 	    }
                    103: 	}
                    104:     } elsif ($type eq 'slots') {
                    105: 	foreach my $key (keys(%{$db})) {
                    106: 	    my $value = $db-&gt;{$key};
                    107: 	    $value = &amp;Apache::lonnet::thaw_unescape($value);
                    108: 	    if (exists($value-&gt;{'proctor'})) {
                    109: 		$value-&gt;{'proctor'} = &amp;update_value($value-&gt;{'proctor'});
                    110: 	    }
                    111: 	    if (exists($value-&gt;{'allowedusers'})) {
                    112: 		$value-&gt;{'allowedusers'} = 
                    113: 		    &amp;update_value($value-&gt;{'allowedusers'});
                    114: 	    }
                    115: 	    $db-&gt;{$key} = &amp;Apache::lonnet::freeze_escape($value);
                    116: 	}
                    117:     } elsif ($type eq 'reservation') {
                    118: 	foreach my $key (keys(%{$db})) {
                    119: 	    my $value = $db-&gt;{$key};
                    120: 	    $value = &amp;Apache::lonnet::thaw_unescape($value);
                    121: 	    if (exists($value-&gt;{'name'})) {
                    122: 		$value-&gt;{'name'} = &amp;update_value($value-&gt;{'name'});
                    123: 	    }
                    124: 	    $db-&gt;{$key} = &amp;Apache::lonnet::freeze_escape($value);
                    125: 	}   
                    126:     } else {
                    127: 	print("$type unsupported\n");
                    128:     }
1.3       albertel  129:     &amp;LONCAPA::locking_hash_untie($db);
1.1       albertel  130: 
                    131: }
                    132: 
                    133: 
                    134: sub main {
                    135:      print("Updating grading queue and slot definitions\n");
                    136:      my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
                    137:      find(
                    138:          {
                    139: 	     no_chdir   =&gt; 1,
                    140: 	     wanted     =&gt; \&amp;process_gradingqueue_file,
                    141: 	 }, 
1.2       albertel  142:          $perlvar->{'lonUsersDir'});
1.1       albertel  143:      print("\n");
                    144: }
                    145: 
                    146: &amp;main();
                    147: 
                    148: </perlscript>
                    149: </file>
                    150: </files>
                    151: </piml>

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>