--- loncom/debugging_tools/make_slots.pl 2005/11/08 02:17:33 1.6 +++ loncom/debugging_tools/make_slots.pl 2006/06/27 15:04:51 1.7 @@ -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 @@ Possibly Need: (but not yet supported) =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 @@ $db{'slot1'}= '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 @@ $db{'slot2'}= '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 @@ $db{'slot3'}= #'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 @@ $db{'slot4'}= #'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 @@ $db{'slot5'}= '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 @@ $db{'slot6'}= '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; -}