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

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
1.4       albertel   19:   startreserve - unix time that a slot can start being reserved
1.3       albertel   20: 
                     21: Optional:
1.4       albertel   22:   type - either 'preassigned' or 'schedulable_student'
1.3       albertel   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)
1.4       albertel   32:   symb - arrayref of symbs that can be scheduled to be done in this slot
1.5     ! albertel   33:   uniqueperiod - if the user has a reservation that has a uniqueperiod
        !            34:                  that overlaps this don't allow them to schedule this
        !            35:                  slot
1.3       albertel   36: Possibly Need: (but not yet supported)
1.5     ! albertel   37:   secret - arrary ref of words that are the secret for this slot
1.3       albertel   38: 
                     39: 
                     40: =cut
                     41: 
1.1       albertel   42: $db{'slot1'}=
                     43:     &freeze_escape({
1.3       albertel   44: 	'type'      => 'preassigned',
1.4       albertel   45: 	'startreserve' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
1.1       albertel   46: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
                     47: 	'endtime'   => &UnixDate("Aug 30th 01:00:00 2004","%s"),
                     48: 	'ip'        => "*albertelli.com",
1.2       albertel   49: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   50:     });
                     51: $db{'slot2'}=
                     52:     &freeze_escape({
1.3       albertel   53: 	'type'      => 'preassigned',
1.4       albertel   54: 	'startreserve' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
1.1       albertel   55: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
                     56: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
                     57: 	'ip'        => "*albertelli.com",
1.2       albertel   58: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   59:     });
                     60: $db{'slot3'}=
                     61:     &freeze_escape({
1.3       albertel   62: 	'type'      => 'preassigned',
                     63: 	'description' => 'slot3',
1.4       albertel   64: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
1.1       albertel   65: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
                     66: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
1.3       albertel   67:         'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
1.5     ! albertel   68: 	#'ip'        => "1.2.3.4",
        !            69: 	#'ip'        => "*albertelli.com",
1.2       albertel   70: 	'proctor'   => 'testuser@annarbor',
1.1       albertel   71:     });
                     72: $db{'slot4'}=
                     73:     &freeze_escape({
1.3       albertel   74: 	'type'      => 'preassigned',
1.4       albertel   75: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
1.3       albertel   76: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
                     77: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
                     78: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
1.5     ! albertel   79: 	#'ip'        => "*albertelli.com",
1.3       albertel   80: 	'proctor'   => 'testuser@annarbor',
                     81:     });
                     82: $db{'slot5'}=
                     83:     &freeze_escape({
                     84: 	'type'      => 'schedulable_student',
1.5     ! albertel   85: 	'description' => 'Aug 30th 4 P.M., Room 123 Kedzie',
1.4       albertel   86: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
1.5     ! albertel   87: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
1.4       albertel   88: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
1.5     ! albertel   89: 	'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
        !            90: 	#'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
1.4       albertel   91: 	#'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
1.5     ! albertel   92: 	#'ip'        => "*albertelli.com,"
1.3       albertel   93: 	'proctor'   => 'testuser@annarbor',
1.5     ! albertel   94: 	'uniqueperiod' => [&UnixDate("Aug 30th 00:00:00 2004","%s"),
        !            95: 			   &UnixDate("Aug 30th 00:00:00 2005","%s")],
1.3       albertel   96:     });
                     97: $db{'slot6'}=
                     98:     &freeze_escape({
                     99: 	'type'      => 'schedulable_student',
                    100: 	'description' => 'Aug 31th 4 P.M., Room 222 Computer Center',
1.4       albertel  101: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
1.5     ! albertel  102: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
1.1       albertel  103: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
1.4       albertel  104: 	#'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
1.5     ! albertel  105: 	#'ip'        => "*albertelli.com",
1.2       albertel  106: 	'proctor'   => 'testuser@annarbor',
1.5     ! albertel  107: 	'uniqueperiod' => [&UnixDate("Aug 1st 00:00:00 2005","%s"),
        !           108: 			   &UnixDate("Aug 30th 00:00:00 2006","%s")],
1.1       albertel  109:     });
                    110: 
                    111: sub freeze_escape {
                    112:     my ($value)=@_;
                    113:     if (ref($value)) {
                    114: 	$value=&nfreeze($value);
                    115: 	return '__FROZEN__'.&escape($value);
                    116:     }
                    117:     return &escape($value);
                    118: }
                    119: 
                    120: sub escape {
                    121:     my $str=shift;
                    122:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
                    123:     return $str;
                    124: }
                    125: 
                    126: sub thaw_unescape {
                    127:     my ($value)=@_;
                    128:     if ($value =~ /^__FROZEN__/) {
                    129: 	substr($value,0,10,undef);
                    130: 	$value=&unescape($value);
                    131: 	return &thaw($value);
                    132:     }
                    133:     return &unescape($value);
                    134: }
                    135: 
                    136: sub unescape {
                    137:     my $str=shift;
                    138:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    139:     return $str;
                    140: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>