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: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>