File:  [LON-CAPA] / loncom / debugging_tools / make_slots.pl
Revision 1.4: download - view: text, annotated - select for diffs
Sat Jun 4 08:17:32 2005 UTC (19 years ago) by albertel
Branches: MAIN
CVS tags: version_1_99_2, version_1_99_1, version_1_99_0, HEAD
- adding the startreserve attribute

    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:   startreserve - unix time that a slot can start being reserved
   20: 
   21: Optional:
   22:   type - either 'preassigned' or 'schedulable_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:   symb - arrayref of symbs that can be scheduled to be done in this slot
   33: 
   34: Possibly Need: (but not yet supported)
   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: 	'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 2006","%s"),
   56: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   57: 	'ip'        => "*albertelli.com",
   58: 	'proctor'   => 'testuser@annarbor',
   59:     });
   60: $db{'slot3'}=
   61:     &freeze_escape({
   62: 	'type'      => 'preassigned',
   63: 	'description' => 'slot3',
   64: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
   65: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   66: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   67:         'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   68: 	'ip'        => "1.2.3.4",
   69: 	'ip'        => "*albertelli.com",
   70: 	'proctor'   => 'testuser@annarbor',
   71:     });
   72: $db{'slot4'}=
   73:     &freeze_escape({
   74: 	'type'      => 'preassigned',
   75: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
   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"),
   79: 	'ip'        => "*albertelli.com",
   80: 	'proctor'   => 'testuser@annarbor',
   81:     });
   82: $db{'slot5'}=
   83:     &freeze_escape({
   84: 	'type'      => 'schedulable_student',
   85: 	'description' => undef,#'Aug 30th 4 P.M., Room 123 Kedzie',
   86: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
   87: 	#'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   88: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   89: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
   90: 	#'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
   91: 	'ip'        => "*albertelli.com",
   92: 	'proctor'   => 'testuser@annarbor',
   93:     });
   94: $db{'slot6'}=
   95:     &freeze_escape({
   96: 	'type'      => 'schedulable_student',
   97: 	'description' => 'Aug 31th 4 P.M., Room 222 Computer Center',
   98: 	'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
   99: 	'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  100: 	'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
  101: 	#'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  102: 	'ip'        => "*albertelli.com",
  103: 	'proctor'   => 'testuser@annarbor',
  104:     });
  105: 
  106: sub freeze_escape {
  107:     my ($value)=@_;
  108:     if (ref($value)) {
  109: 	$value=&nfreeze($value);
  110: 	return '__FROZEN__'.&escape($value);
  111:     }
  112:     return &escape($value);
  113: }
  114: 
  115: sub escape {
  116:     my $str=shift;
  117:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  118:     return $str;
  119: }
  120: 
  121: sub thaw_unescape {
  122:     my ($value)=@_;
  123:     if ($value =~ /^__FROZEN__/) {
  124: 	substr($value,0,10,undef);
  125: 	$value=&unescape($value);
  126: 	return &thaw($value);
  127:     }
  128:     return &unescape($value);
  129: }
  130: 
  131: sub unescape {
  132:     my $str=shift;
  133:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  134:     return $str;
  135: }

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