Return to make_slots.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

Annotation of loncom/debugging_tools/make_slots.pl, revision 1.2

1.1       albertel    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",
1.2     ! albertel   16: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   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",
1.2     ! albertel   23: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   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",
1.2     ! albertel   30: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   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",
1.2     ! albertel   37: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   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: }