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>