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

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.2     ! albertel    6: <!-- $Id: update_queue_slots.piml,v 1.1 2006/06/05 23:18:45 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.1       albertel   83:     my $prefix = $_;
                     84:     $prefix =~s/\.db$//;
                     85:     my $db = &amp;LONCAPA::_locking_hash_tie($prefix,'nohist_',&amp;GDBM_WRCREAT());
                     86:     if ($type eq 'queue') {
                     87: 	foreach my $key (keys(%{$db})) {
                     88: 	    my $real_key = &amp;unescape($key);
                     89: 	    my (@elements) = split("\0",$real_key);
                     90: 	    if (exists($elements[2])) {
                     91: 		$elements[2] = &amp;update_value($elements[2]);
                     92: 	    }
                     93: 	    $real_key = join("\0",@elements);
                     94: 	    my $new_key = &amp;escape($real_key);
                     95: 	    if ($new_key ne $key) {
                     96: 		$db-&gt;{$new_key} = $db-&gt;{$key};
                     97: 		delete($db-&gt;{$key});
                     98: 	    }
                     99: 	    if ($new_key =~ /locked$/) {
                    100: 		my $value = $db-&gt;{$new_key};
                    101: 		my $new_value = &amp;unescape($value);
                    102: 		$new_value = &amp;update_value($new_value);
                    103: 		$db-&gt;{$new_key} = &amp;escape($new_value);
                    104: 	    }
                    105: 	}
                    106:     } elsif ($type eq 'slots') {
                    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;{'proctor'})) {
                    111: 		$value-&gt;{'proctor'} = &amp;update_value($value-&gt;{'proctor'});
                    112: 	    }
                    113: 	    if (exists($value-&gt;{'allowedusers'})) {
                    114: 		$value-&gt;{'allowedusers'} = 
                    115: 		    &amp;update_value($value-&gt;{'allowedusers'});
                    116: 	    }
                    117: 	    $db-&gt;{$key} = &amp;Apache::lonnet::freeze_escape($value);
                    118: 	}
                    119:     } elsif ($type eq 'reservation') {
                    120: 	foreach my $key (keys(%{$db})) {
                    121: 	    my $value = $db-&gt;{$key};
                    122: 	    $value = &amp;Apache::lonnet::thaw_unescape($value);
                    123: 	    if (exists($value-&gt;{'name'})) {
                    124: 		$value-&gt;{'name'} = &amp;update_value($value-&gt;{'name'});
                    125: 	    }
                    126: 	    $db-&gt;{$key} = &amp;Apache::lonnet::freeze_escape($value);
                    127: 	}   
                    128:     } else {
                    129: 	print("$type unsupported\n");
                    130:     }
                    131:     &amp;untie_user_hash($db);
                    132: 
                    133: }
                    134: 
                    135: 
                    136: sub main {
                    137:      print("Updating grading queue and slot definitions\n");
                    138:      my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
                    139:      find(
                    140:          {
                    141: 	     no_chdir   =&gt; 1,
                    142: 	     wanted     =&gt; \&amp;process_gradingqueue_file,
                    143: 	 }, 
1.2     ! albertel  144:          $perlvar->{'lonUsersDir'});
1.1       albertel  145:      print("\n");
                    146: }
                    147: 
                    148: &amp;main();
                    149: 
                    150: </perlscript>
                    151: </file>
                    152: </files>
                    153: </piml>

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