[LON-CAPA-cvs] cvs: loncom /debugging_tools make_slots.pl
albertel
lon-capa-cvs@mail.lon-capa.org
Tue, 27 Jun 2006 15:04:51 -0000
albertel Tue Jun 27 11:04:51 2006 EDT
Modified files:
/loncom/debugging_tools make_slots.pl
Log:
- LONCAPA morph
Index: loncom/debugging_tools/make_slots.pl
diff -u loncom/debugging_tools/make_slots.pl:1.6 loncom/debugging_tools/make_slots.pl:1.7
--- loncom/debugging_tools/make_slots.pl:1.6 Mon Nov 7 21:17:33 2005
+++ loncom/debugging_tools/make_slots.pl Tue Jun 27 11:04:51 2006
@@ -1,10 +1,14 @@
use Date::Manip;
use GDBM_File;
use Storable qw(nfreeze thaw);
+use lib '/home/httpd/lib/perl/';
+use LONCAPA;
+use Apache::lonnet;
my $fname="/home/httpd/lonUsers/annarbor/9/7/7/9778182de3942c1annarborl2/slots.db";
-my %db;
-if (! tie(%db,'GDBM_File',$fname,&GDBM_WRITER(),0640)) {
+
+my $db = &LONCAPA::locking_hash_tie($fname,&GDBM_WRCREAT());
+if (! $db) {
warn "Unable to tie to $fname";
exit;
}
@@ -39,8 +43,8 @@
=cut
-$db{'slot1'}=
- &freeze_escape({
+$db->{'slot1'}=
+ &Apache::lonnet::freeze_escape({
'type' => 'preassigned',
'startreserve' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
@@ -48,8 +52,8 @@
'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
-$db{'slot2'}=
- &freeze_escape({
+$db->{'slot2'}=
+ &Apache::lonnet::freeze_escape({
'type' => 'preassigned',
'startreserve' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
@@ -59,8 +63,8 @@
'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
-$db{'slot3'}=
- &freeze_escape({
+$db->{'slot3'}=
+ &Apache::lonnet::freeze_escape({
'type' => 'preassigned',
'description' => 'slot3',
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
@@ -71,8 +75,8 @@
#'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
-$db{'slot4'}=
- &freeze_escape({
+$db->{'slot4'}=
+ &Apache::lonnet::freeze_escape({
'type' => 'preassigned',
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
@@ -81,8 +85,8 @@
#'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
-$db{'slot5'}=
- &freeze_escape({
+$db->{'slot5'}=
+ &Apache::lonnet::freeze_escape({
'type' => 'schedulable_student',
'description' => 'Aug 30th 4 P.M., Room 123 Kedzie',
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
@@ -98,8 +102,8 @@
'maxspace' => 10,
'secret' => 'sauce'
});
-$db{'slot6'}=
- &freeze_escape({
+$db->{'slot6'}=
+ &Apache::lonnet::freeze_escape({
'type' => 'schedulable_student',
'description' => 'Aug 31th 4 P.M., Room 222 Computer Center',
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
@@ -114,33 +118,3 @@
'maxspace' => 4,
});
-sub freeze_escape {
- my ($value)=@_;
- if (ref($value)) {
- $value=&nfreeze($value);
- return '__FROZEN__'.&escape($value);
- }
- return &escape($value);
-}
-
-sub escape {
- my $str=shift;
- $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
- return $str;
-}
-
-sub thaw_unescape {
- my ($value)=@_;
- if ($value =~ /^__FROZEN__/) {
- substr($value,0,10,undef);
- $value=&unescape($value);
- return &thaw($value);
- }
- return &unescape($value);
-}
-
-sub unescape {
- my $str=shift;
- $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
- return $str;
-}