[LON-CAPA-cvs] cvs: doc /loncapafiles update_queue_slots.piml

[albertel]

albertel		Mon Jun  5 19:18:45 2006 EDT

  Added files:                 
    /doc/loncapafiles	update_queue_slots.piml 
  Log:
  - adding piml for updating the slto definitions and queue entries between 2.1 and 2.2
  
  

Index: doc/loncapafiles/update_queue_slots.piml
+++ doc/loncapafiles/update_queue_slots.piml
<!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.1 2006/06/05 23:18:45 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;
sub process_gradingqueue_file {
    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 $count = length("$updated");
    $updated++;
    print("\b"x(14+$count));
    print("Updated $updated files");
    my $prefix = $_;
    $prefix =~s/\.db$//;
    my $db = &amp;LONCAPA::_locking_hash_tie($prefix,'nohist_',&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;untie_user_hash($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,
	 }, 
         '/home/www/lonUsers/');
     print("\n");
}

&amp;main();

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