use Date::Manip;
use GDBM_File;
use Storable qw(nfreeze thaw);
my $fname="/home/httpd/lonUsers/annarbor/9/7/7/9778182de3942c1annarborl2/slots.db";
my %db;
if (! tie(%db,'GDBM_File',$fname,&GDBM_WRITER(),0640)) {
warn "Unable to tie to $fname";
exit;
}
=pod
slots can have these parts;:
Required:
starttime - unix time that a slot start
endtime - unix time that a slot ends
type - either 'preassigned' or 'schedulable_student'
(controls whether slotrequest.pm will allow one to select it)
Optional:
startreserve - unix time that a slot can start being reserved
ip - comma seperated list of ip address or wildcard ranges or
wilcard hostnames, or [] style range of allowable client IP
addresses
proctor - comma seperated list of user@domain that can checkin a user
description - string that will displayed to people when talking about
this slot
maxspace - integer (number of people that can schedule this space)
(if unspecfied no limit is used)
symb - arrayref of symbs that can be scheduled to be done in this slot
uniqueperiod - if the user has a reservation that has a uniqueperiod
that overlaps this don't allow them to schedule this
slot
secret - arrary ref of words that are the secret for this slot
Possibly Need: (but not yet supported)
=cut
$db{'slot1'}=
&freeze_escape({
'type' => 'preassigned',
'startreserve' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'endtime' => &UnixDate("Aug 30th 01:00:00 2004","%s"),
'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
$db{'slot2'}=
&freeze_escape({
'type' => 'preassigned',
'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 2006","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
$db{'slot3'}=
&freeze_escape({
'type' => 'preassigned',
'description' => 'slot3',
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
#'ip' => "1.2.3.4",
#'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
$db{'slot4'}=
&freeze_escape({
'type' => 'preassigned',
'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
#'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
$db{'slot5'}=
&freeze_escape({
'type' => 'schedulable_student',
'description' => 'Aug 30th 4 P.M., Room 123 Kedzie',
'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 2006","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
#'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
#'ip' => "*albertelli.com,"
'proctor' => 'testuser@annarbor',
'uniqueperiod' => [&UnixDate("Aug 30th 00:00:00 2004","%s"),
&UnixDate("Aug 30th 00:00:00 2005","%s")],
'maxspace' => 10,
'secret' => 'sauce'
});
$db{'slot6'}=
&freeze_escape({
'type' => 'schedulable_student',
'description' => 'Aug 31th 4 P.M., Room 222 Computer Center',
'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 2006","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
#'endtime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
#'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
'uniqueperiod' => [&UnixDate("Aug 1st 00:00:00 2005","%s"),
&UnixDate("Aug 30th 00:00:00 2006","%s")],
'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;
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>