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

<!DOCTYPE piml PUBLIC "-//TUX/DTD piml 1.0 Final//EN" 
	"http://lpml.sourceforge.net/DTD/piml.dtd">
<!-- accesscount_seed.piml -->
<!-- Matthew Hall -->

<!-- $Id: update_queue_slots.piml,v 1.4 2006/06/28 20:48:04 albertel Exp $ -->

<!--

This file is part of the LearningOnline Network with CAPA (LON-CAPA).

LON-CAPA is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

LON-CAPA is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with LON-CAPA; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

/home/httpd/html/adm/gpl.txt

http://www.lon-capa.org/

-->

<piml>
<targetroot>/</targetroot>
<files>
<file>
<target dist="default">/home/httpd/lonUsers</target>
<perlscript mode="fg">
use strict;
use File::Find;
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
use LONCAPA;
use GDBM_File;
use Storable;
use Apache::lonnet;

$|=1;

sub update_value {
    my ($value) = @_;
    if ($value =~ /@/ &amp;&amp; $value !~ /:/) {
	$value =~ tr/@/:/;
    }
    return $value;
}

my $updated=0;
my %dirs;
my $last;
my $total;
sub process_gradingqueue_file {
    my $which = (split('/',$_))[5];
    $dirs{$which} = 1;
    my $count2 = length("$last");
    my $count = length("$updated");
    my $backup = "\b"x(8+$count2+14+$count+6);
    if (scalar(keys(%dirs)) > $last) {
         $last = scalar(keys(%dirs));
         print($backup."Updated $last directories, $updated files");
    }
    return if ($_!~m/(gradingqueue|reviewqueue|slots|slot_reservations)\.db$/);
    my $type='queue';
    if ($1 eq 'slots') {
	$type = 'slots';
    } elsif ($1 eq 'slot_reservations') {
	$type = 'reservation';
    }
    my $count2 = length("$last");
    my $count = length("$updated");
    my $backup = "\b"x(8+$count2+14+$count+6);
    $updated++;
    print($backup."Updated $last directories, $updated files");
    my $db = &amp;LONCAPA::locking_hash_tie($_,&amp;GDBM_WRCREAT());
    if ($type eq 'queue') {
	foreach my $key (keys(%{$db})) {
	    my $real_key = &amp;unescape($key);
	    my (@elements) = split("\0",$real_key);
	    if (exists($elements[2])) {
		$elements[2] = &amp;update_value($elements[2]);
	    }
	    $real_key = join("\0",@elements);
	    my $new_key = &amp;escape($real_key);
	    if ($new_key ne $key) {
		$db-&gt;{$new_key} = $db-&gt;{$key};
		delete($db-&gt;{$key});
	    }
	    if ($new_key =~ /locked$/) {
		my $value = $db-&gt;{$new_key};
		my $new_value = &amp;unescape($value);
		$new_value = &amp;update_value($new_value);
		$db-&gt;{$new_key} = &amp;escape($new_value);
	    }
	}
    } elsif ($type eq 'slots') {
	foreach my $key (keys(%{$db})) {
	    my $value = $db-&gt;{$key};
	    $value = &amp;Apache::lonnet::thaw_unescape($value);
	    if (exists($value-&gt;{'proctor'})) {
		$value-&gt;{'proctor'} = &amp;update_value($value-&gt;{'proctor'});
	    }
	    if (exists($value-&gt;{'allowedusers'})) {
		$value-&gt;{'allowedusers'} = 
		    &amp;update_value($value-&gt;{'allowedusers'});
	    }
	    $db-&gt;{$key} = &amp;Apache::lonnet::freeze_escape($value);
	}
    } elsif ($type eq 'reservation') {
	foreach my $key (keys(%{$db})) {
	    my $value = $db-&gt;{$key};
	    $value = &amp;Apache::lonnet::thaw_unescape($value);
	    if (exists($value-&gt;{'name'})) {
		$value-&gt;{'name'} = &amp;update_value($value-&gt;{'name'});
	    }
	    $db-&gt;{$key} = &amp;Apache::lonnet::freeze_escape($value);
	}   
    } else {
	print("$type unsupported\n");
    }
    &amp;LONCAPA::locking_hash_untie($db);

}


sub main {
     print("Updating grading queue and slot definitions\n");
     my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
     find(
         {
	     no_chdir   =&gt; 1,
	     wanted     =&gt; \&amp;process_gradingqueue_file,
	 }, 
         $perlvar->{'lonUsersDir'});
     print("\n");
}

&amp;main();

</perlscript>
</file>
</files>
</piml>

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