Return to make_slots.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- added protor field to slots

    1: use Date::Manip;
    2: use GDBM_File;
    3: use Storable qw(nfreeze thaw);
    4: 
    5: my $fname="/home/httpd/lonUsers/annarbor/9/7/7/9778182de3942c1annarborl2/slots.db";
    6: my %db;
    7: if (! tie(%db,'GDBM_File',$fname,&GDBM_WRITER(),0640)) {
    8:     warn "Unable to tie to $fname";
    9:     exit;
   10: }
   11: $db{'slot1'}=
   12:     &freeze_escape({
   13: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   14: 	'endtime'   => &UnixDate("Aug 30th 01:00:00 2004","%s"),
   15: 	'ip'        => "*albertelli.com",
   16: 	'proctor'   => 'testuser@annarbor',
   17:     });
   18: $db{'slot2'}=
   19:     &freeze_escape({
   20: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   21: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   22: 	'ip'        => "*albertelli.com",
   23: 	'proctor'   => 'testuser@annarbor',
   24:     });
   25: $db{'slot3'}=
   26:     &freeze_escape({
   27: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   28: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   29: 	'ip'        => "1.2.3.4",
   30: 	'proctor'   => 'testuser@annarbor',
   31:     });
   32: $db{'slot4'}=
   33:     &freeze_escape({
   34: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   35: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   36: 	'ip'        => "*albertelli.com",
   37: 	'proctor'   => 'testuser@annarbor',
   38:     });
   39: 
   40: sub freeze_escape {
   41:     my ($value)=@_;
   42:     if (ref($value)) {
   43: 	$value=&nfreeze($value);
   44: 	return '__FROZEN__'.&escape($value);
   45:     }
   46:     return &escape($value);
   47: }
   48: 
   49: sub escape {
   50:     my $str=shift;
   51:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
   52:     return $str;
   53: }
   54: 
   55: sub thaw_unescape {
   56:     my ($value)=@_;
   57:     if ($value =~ /^__FROZEN__/) {
   58: 	substr($value,0,10,undef);
   59: 	$value=&unescape($value);
   60: 	return &thaw($value);
   61:     }
   62:     return &unescape($value);
   63: }
   64: 
   65: sub unescape {
   66:     my $str=shift;
   67:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
   68:     return $str;
   69: }