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

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.5     ! raeburn     6: <!-- $Id: update_queue_slots.piml,v 1.4 2006/06/28 20:48:04 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 {
1.5     ! raeburn   135:     my $doupdate;
        !           136:     if (-e '/etc/loncapa-release') {
        !           137:         if (open(PIPE,"cat /etc/loncapa-release.prev |grep '^LON-CAPA release' |")) {
        !           138:             if (&lt;PIPE&gt; =~ /^\QLON-CAPA release \E(CVS_HEAD|\d+\.\d+\.\d+\.?\w*)\-\d+$/) {
        !           139:                 my $previous = $1;
        !           140:                 unless ($previous eq 'CVS_HEAD') {
        !           141:                     my ($major,$minor) = ($previous =~ /^(\d+)\.(\d+)\./);
        !           142:                     if (($major ne '') && ($minor ne '')) {
        !           143:                         if (($major == 2) && ($minor &lt; 10)) {
        !           144:                             $doupdate = 1;
        !           145:                         }
        !           146:                     }
        !           147:                 }
        !           148:             }
        !           149:             close(PIPE);
        !           150:         }
        !           151:      }
        !           152: 
        !           153:      if ($doupdate) {
        !           154:          print("Updating grading queue and slot definitions\n");
        !           155:          my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
        !           156:          find(
        !           157:              {
        !           158: 	         no_chdir   =&gt; 1,
        !           159: 	         wanted     =&gt; \&amp;process_gradingqueue_file,
        !           160: 	     },
        !           161:              $perlvar->{'lonUsersDir'});
        !           162:          print("\n");
        !           163:      } else {
        !           164:          print("Update of grading queue and slot definitions not required.\n"); 
        !           165:      }
1.1       albertel  166: }
                    167: 
                    168: &amp;main();
                    169: 
                    170: </perlscript>
                    171: </file>
                    172: </files>
                    173: </piml>

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