File:  [LON-CAPA] / loncom / debugging_tools / make_slots.pl
Revision 1.6: download - view: text, annotated - select for diffs
Tue Nov 8 02:17:33 2005 UTC (18 years, 6 months ago) by albertel
Branches: MAIN
CVS tags: version_2_1_X, version_2_1_3, version_2_1_2, version_2_1_1, version_2_1_0, version_2_0_99_1, HEAD
- update docs on 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: 
   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:   type - either 'preassigned' or 'schedulable_student'
   20:          (controls whether slotrequest.pm will allow one to select it)
   21: 
   22: Optional:
   23:   startreserve - unix time that a slot can start being reserved
   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:   symb - arrayref of symbs that can be scheduled to be done in this slot
   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
   36:   secret - arrary ref of words that are the secret for this slot
   37: Possibly Need: (but not yet supported)
   38: 
   39: 
   40: =cut
   41: 
   42: $db{'slot1'}=
   43:     &freeze_escape({
   44: 	'type'      => 'preassigned',
   45: 	'startreserve' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   46: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   47: 	'endtime'   => &UnixDate("Aug 30th 01:00:00 2004","%s"),
   48: 	'ip'        => "*albertelli.com",
   49: 	'proctor'   => 'testuser@annarbor',
   50:     });
   51: $db{'slot2'}=
   52:     &freeze_escape({
   53: 	'type'      => 'preassigned',
   54: 	'startreserve' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   55: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   56: 	#'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   57: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   58: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   59: 	'ip'        => "*albertelli.com",
   60: 	'proctor'   => 'testuser@annarbor',
   61:     });
   62: $db{'slot3'}=
   63:     &freeze_escape({
   64: 	'type'      => 'preassigned',
   65: 	'description' => 'slot3',
   66: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
   67: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   68: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   69:         'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   70: 	#'ip'        => "1.2.3.4",
   71: 	#'ip'        => "*albertelli.com",
   72: 	'proctor'   => 'testuser@annarbor',
   73:     });
   74: $db{'slot4'}=
   75:     &freeze_escape({
   76: 	'type'      => 'preassigned',
   77: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
   78: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   79: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   80: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   81: 	#'ip'        => "*albertelli.com",
   82: 	'proctor'   => 'testuser@annarbor',
   83:     });
   84: $db{'slot5'}=
   85:     &freeze_escape({
   86: 	'type'      => 'schedulable_student',
   87: 	'description' => 'Aug 30th 4 P.M., Room 123 Kedzie',
   88: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
   89: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   90: 	#'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   91: 	'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   92: 	#'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   93: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   94: 	#'ip'        => "*albertelli.com,"
   95: 	'proctor'   => 'testuser@annarbor',
   96: 	'uniqueperiod' => [&UnixDate("Aug 30th 00:00:00 2004","%s"),
   97: 			   &UnixDate("Aug 30th 00:00:00 2005","%s")],
   98: 	'maxspace' => 10,
   99: 	'secret'   => 'sauce'
  100:     });
  101: $db{'slot6'}=
  102:     &freeze_escape({
  103: 	'type'      => 'schedulable_student',
  104: 	'description' => 'Aug 31th 4 P.M., Room 222 Computer Center',
  105: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
  106: 	#'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  107: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
  108: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
  109: 	#'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  110: 	#'ip'        => "*albertelli.com",
  111: 	'proctor'   => 'testuser@annarbor',
  112: 	'uniqueperiod' => [&UnixDate("Aug 1st 00:00:00 2005","%s"),
  113: 			   &UnixDate("Aug 30th 00:00:00 2006","%s")],
  114: 	'maxspace' => 4,
  115:     });
  116: 
  117: sub freeze_escape {
  118:     my ($value)=@_;
  119:     if (ref($value)) {
  120: 	$value=&nfreeze($value);
  121: 	return '__FROZEN__'.&escape($value);
  122:     }
  123:     return &escape($value);
  124: }
  125: 
  126: sub escape {
  127:     my $str=shift;
  128:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  129:     return $str;
  130: }
  131: 
  132: sub thaw_unescape {
  133:     my ($value)=@_;
  134:     if ($value =~ /^__FROZEN__/) {
  135: 	substr($value,0,10,undef);
  136: 	$value=&unescape($value);
  137: 	return &thaw($value);
  138:     }
  139:     return &unescape($value);
  140: }
  141: 
  142: sub unescape {
  143:     my $str=shift;
  144:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  145:     return $str;
  146: }

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