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;
}
$db{'slot1'}=
&freeze_escape({
'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({
'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
$db{'slot3'}=
&freeze_escape({
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'ip' => "1.2.3.4",
'proctor' => 'testuser@annarbor',
});
$db{'slot4'}=
&freeze_escape({
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'ip' => "*albertelli.com",
'proctor' => 'testuser@annarbor',
});
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>