version 1.6, 2005/11/08 02:17:33
|
version 1.7, 2006/06/27 15:04:51
|
Line 1
|
Line 1
|
use Date::Manip; |
use Date::Manip; |
use GDBM_File; |
use GDBM_File; |
use Storable qw(nfreeze thaw); |
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 $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"; |
warn "Unable to tie to $fname"; |
exit; |
exit; |
} |
} |
Line 39 Possibly Need: (but not yet supported)
|
Line 43 Possibly Need: (but not yet supported)
|
|
|
=cut |
=cut |
|
|
$db{'slot1'}= |
$db->{'slot1'}= |
&freeze_escape({ |
&Apache::lonnet::freeze_escape({ |
'type' => 'preassigned', |
'type' => 'preassigned', |
'startreserve' => &UnixDate("Aug 30th 00:00:00 2004","%s"), |
'startreserve' => &UnixDate("Aug 30th 00:00:00 2004","%s"), |
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"), |
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"), |
Line 48 $db{'slot1'}=
|
Line 52 $db{'slot1'}=
|
'ip' => "*albertelli.com", |
'ip' => "*albertelli.com", |
'proctor' => 'testuser@annarbor', |
'proctor' => 'testuser@annarbor', |
}); |
}); |
$db{'slot2'}= |
$db->{'slot2'}= |
&freeze_escape({ |
&Apache::lonnet::freeze_escape({ |
'type' => 'preassigned', |
'type' => 'preassigned', |
'startreserve' => &UnixDate("Aug 30th 00:00:00 2006","%s"), |
'startreserve' => &UnixDate("Aug 30th 00:00:00 2006","%s"), |
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"), |
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"), |
Line 59 $db{'slot2'}=
|
Line 63 $db{'slot2'}=
|
'ip' => "*albertelli.com", |
'ip' => "*albertelli.com", |
'proctor' => 'testuser@annarbor', |
'proctor' => 'testuser@annarbor', |
}); |
}); |
$db{'slot3'}= |
$db->{'slot3'}= |
&freeze_escape({ |
&Apache::lonnet::freeze_escape({ |
'type' => 'preassigned', |
'type' => 'preassigned', |
'description' => 'slot3', |
'description' => 'slot3', |
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"), |
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"), |
Line 71 $db{'slot3'}=
|
Line 75 $db{'slot3'}=
|
#'ip' => "*albertelli.com", |
#'ip' => "*albertelli.com", |
'proctor' => 'testuser@annarbor', |
'proctor' => 'testuser@annarbor', |
}); |
}); |
$db{'slot4'}= |
$db->{'slot4'}= |
&freeze_escape({ |
&Apache::lonnet::freeze_escape({ |
'type' => 'preassigned', |
'type' => 'preassigned', |
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"), |
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"), |
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"), |
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"), |
Line 81 $db{'slot4'}=
|
Line 85 $db{'slot4'}=
|
#'ip' => "*albertelli.com", |
#'ip' => "*albertelli.com", |
'proctor' => 'testuser@annarbor', |
'proctor' => 'testuser@annarbor', |
}); |
}); |
$db{'slot5'}= |
$db->{'slot5'}= |
&freeze_escape({ |
&Apache::lonnet::freeze_escape({ |
'type' => 'schedulable_student', |
'type' => 'schedulable_student', |
'description' => 'Aug 30th 4 P.M., Room 123 Kedzie', |
'description' => 'Aug 30th 4 P.M., Room 123 Kedzie', |
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"), |
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"), |
Line 98 $db{'slot5'}=
|
Line 102 $db{'slot5'}=
|
'maxspace' => 10, |
'maxspace' => 10, |
'secret' => 'sauce' |
'secret' => 'sauce' |
}); |
}); |
$db{'slot6'}= |
$db->{'slot6'}= |
&freeze_escape({ |
&Apache::lonnet::freeze_escape({ |
'type' => 'schedulable_student', |
'type' => 'schedulable_student', |
'description' => 'Aug 31th 4 P.M., Room 222 Computer Center', |
'description' => 'Aug 31th 4 P.M., Room 222 Computer Center', |
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"), |
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"), |
Line 114 $db{'slot6'}=
|
Line 118 $db{'slot6'}=
|
'maxspace' => 4, |
'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; |
|
} |
|