Return to make_slots.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- added some documentation and some more slots to my example

    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: 
   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: 
   42: $db{'slot1'}=
   43:     &freeze_escape({
   44: 	'type'      => 'preassigned',
   45: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   46: 	'endtime'   => &UnixDate("Aug 30th 01:00:00 2004","%s"),
   47: 	'ip'        => "*albertelli.com",
   48: 	'proctor'   => 'testuser@annarbor',
   49:     });
   50: $db{'slot2'}=
   51:     &freeze_escape({
   52: 	'type'      => 'preassigned',
   53: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   54: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   55: 	'ip'        => "*albertelli.com",
   56: 	'proctor'   => 'testuser@annarbor',
   57:     });
   58: $db{'slot3'}=
   59:     &freeze_escape({
   60: 	'type'      => 'preassigned',
   61: 	'description' => 'slot3',
   62: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   63: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   64:         'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   65: 	'ip'        => "1.2.3.4",
   66: 	'ip'        => "*albertelli.com",
   67: 	'proctor'   => 'testuser@annarbor',
   68:     });
   69: $db{'slot4'}=
   70:     &freeze_escape({
   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',
   92: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   93: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   94: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   95: 	'ip'        => "*albertelli.com",
   96: 	'proctor'   => 'testuser@annarbor',
   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: }