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>