[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;
-}