File:  [LON-CAPA] / doc / loncapafiles / update_queue_slots.piml
Revision 1.4: download - view: text, annotated - select for diffs
Wed Jun 28 20:48:04 2006 UTC (17 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_X, version_2_8_99_1, version_2_8_99_0, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, version_2_6_2, version_2_6_1, version_2_6_0, version_2_5_X, version_2_5_99_1, version_2_5_99_0, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_X, version_2_4_99_0, version_2_4_2, version_2_4_1, version_2_4_0, version_2_3_X, version_2_3_99_0, version_2_3_2, version_2_3_1, version_2_3_0, version_2_2_X, version_2_2_99_1, version_2_2_99_0, version_2_2_2, version_2_2_1, version_2_2_0, version_2_1_99_3, version_2_1_99_2, version_2_1_99_1, version_2_1_99_0, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, bz6209-base, bz6209, HEAD, GCI_3, GCI_2, GCI_1, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse
- updated calling convention for the locking_hash_tie

    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.4 2006/06/28 20:48:04 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=0;
   58: my %dirs;
   59: my $last;
   60: my $total;
   61: sub process_gradingqueue_file {
   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:     }
   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:     }
   78:     my $count2 = length("$last");
   79:     my $count = length("$updated");
   80:     my $backup = "\b"x(8+$count2+14+$count+6);
   81:     $updated++;
   82:     print($backup."Updated $last directories, $updated files");
   83:     my $db = &amp;LONCAPA::locking_hash_tie($_,&amp;GDBM_WRCREAT());
   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:     }
  129:     &amp;LONCAPA::locking_hash_untie($db);
  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: 	 }, 
  142:          $perlvar->{'lonUsersDir'});
  143:      print("\n");
  144: }
  145: 
  146: &amp;main();
  147: 
  148: </perlscript>
  149: </file>
  150: </files>
  151: </piml>

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