Return to update_queue_slots.piml CVS log

Up to [LON-CAPA] / doc / loncapafiles

- Use correct script name in comment line.

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

<!-- $Id: update_queue_slots.piml,v 1.6 2024/07/08 22:06:15 raeburn 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 {
    my $doupdate;
    if (-e '/etc/loncapa-release') {
        if (open(PIPE,"cat /etc/loncapa-release.prev |grep '^LON-CAPA release' |")) {
            if (&lt;PIPE&gt; =~ /^\QLON-CAPA release \E(CVS_HEAD|\d+\.\d+\.\d+\.?\w*)\-\d+$/) {
                my $previous = $1;
                unless ($previous eq 'CVS_HEAD') {
                    my ($major,$minor) = ($previous =~ /^(\d+)\.(\d+)\./);
                    if (($major ne '') && ($minor ne '')) {
                        if (($major == 2) && ($minor &lt; 10)) {
                            $doupdate = 1;
                        }
                    }
                }
            }
            close(PIPE);
        }
     }

     if ($doupdate) {
         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");
     } else {
         print("Update of grading queue and slot definitions not required.\n"); 
     }
}

&amp;main();

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