Return to make_slots.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

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

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: }
1.3     ! albertel   11: 
        !            12: =pod
        !            13: 
        !            14: slots can have these parts;:
        !            15: 
        !            16: Required:
        !            17:   starttime - unix time that a slot start
        !            18:   endtime - unix time that a slot ends
        !            19:   
        !            20: 
        !            21: Optional:
        !            22:   type - either 'preassigned' or 'scheduleable_student'
        !            23:          (controls whether slotrequest.pm will allow one to select it)
        !            24:   ip - comma seperated list of ip address or wildcard ranges or
        !            25:        wilcard hostnames, or [] style range of allowable client IP
        !            26:        addresses
        !            27:   proctor - comma seperated list of user@domain that can checkin a user
        !            28:   description - string that will displayed to people when talking about 
        !            29:                 this slot
        !            30:   maxspace - integer (number of people that can schedule this space)
        !            31:              (if unspecfied no limit is used)
        !            32: 
        !            33: Possibly Need: (but not yet supported)
        !            34:   symb - arrayref of symbs that can be scheduled to be done in this slot
        !            35:   uniqperiod - if the user has a reservation that has a uniqpersion
        !            36:                that overlaps this dn't allow them to schedule this
        !            37:                reservation
        !            38: 
        !            39: 
        !            40: =cut
        !            41: 
1.1       albertel   42: $db{'slot1'}=
                     43:     &freeze_escape({
1.3     ! albertel   44: 	'type'      => 'preassigned',
1.1       albertel   45: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
                     46: 	'endtime'   => &UnixDate("Aug 30th 01:00:00 2004","%s"),
                     47: 	'ip'        => "*albertelli.com",
1.2       albertel   48: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   49:     });
                     50: $db{'slot2'}=
                     51:     &freeze_escape({
1.3     ! albertel   52: 	'type'      => 'preassigned',
1.1       albertel   53: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
                     54: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
                     55: 	'ip'        => "*albertelli.com",
1.2       albertel   56: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   57:     });
                     58: $db{'slot3'}=
                     59:     &freeze_escape({
1.3     ! albertel   60: 	'type'      => 'preassigned',
        !            61: 	'description' => 'slot3',
1.1       albertel   62: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
                     63: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
1.3     ! albertel   64:         'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
1.1       albertel   65: 	'ip'        => "1.2.3.4",
1.3     ! albertel   66: 	'ip'        => "*albertelli.com",
1.2       albertel   67: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   68:     });
                     69: $db{'slot4'}=
                     70:     &freeze_escape({
1.3     ! albertel   71: 	'type'      => 'preassigned',
        !            72: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
        !            73: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
        !            74: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
        !            75: 	'ip'        => "*albertelli.com",
        !            76: 	'proctor'   => 'testuser@annarbor',
        !            77:     });
        !            78: $db{'slot5'}=
        !            79:     &freeze_escape({
        !            80: 	'type'      => 'schedulable_student',
        !            81: 	'description' => 'Aug 30th 4 P.M., Room 123 Kedzie',
        !            82: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
        !            83: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
        !            84: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
        !            85: 	'ip'        => "*albertelli.com",
        !            86: 	'proctor'   => 'testuser@annarbor',
        !            87:     });
        !            88: $db{'slot6'}=
        !            89:     &freeze_escape({
        !            90: 	'type'      => 'schedulable_student',
        !            91: 	'description' => 'Aug 31th 4 P.M., Room 222 Computer Center',
1.1       albertel   92: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
                     93: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
1.3     ! albertel   94: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
1.1       albertel   95: 	'ip'        => "*albertelli.com",
1.2       albertel   96: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   97:     });
                     98: 
                     99: sub freeze_escape {
                    100:     my ($value)=@_;
                    101:     if (ref($value)) {
                    102: 	$value=&nfreeze($value);
                    103: 	return '__FROZEN__'.&escape($value);
                    104:     }
                    105:     return &escape($value);
                    106: }
                    107: 
                    108: sub escape {
                    109:     my $str=shift;
                    110:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
                    111:     return $str;
                    112: }
                    113: 
                    114: sub thaw_unescape {
                    115:     my ($value)=@_;
                    116:     if ($value =~ /^__FROZEN__/) {
                    117: 	substr($value,0,10,undef);
                    118: 	$value=&unescape($value);
                    119: 	return &thaw($value);
                    120:     }
                    121:     return &unescape($value);
                    122: }
                    123: 
                    124: sub unescape {
                    125:     my $str=shift;
                    126:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    127:     return $str;
                    128: }