[BACK]Return to make_slots.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / debugging_tools

Diff for /loncom/debugging_tools/make_slots.pl between versions 1.3 and 1.7

version 1.3, 2005/05/31 21:35:51 version 1.7, 2006/06/27 15:04:51
Line 1 Line 1
 use Date::Manip;  use Date::Manip;
 use GDBM_File;  use GDBM_File;
 use Storable qw(nfreeze thaw);  use Storable qw(nfreeze thaw);
   use lib '/home/httpd/lib/perl/';
   use LONCAPA;
   use Apache::lonnet;
   
 my $fname="/home/httpd/lonUsers/annarbor/9/7/7/9778182de3942c1annarborl2/slots.db";  my $fname="/home/httpd/lonUsers/annarbor/9/7/7/9778182de3942c1annarborl2/slots.db";
 my %db;  
 if (! tie(%db,'GDBM_File',$fname,&GDBM_WRITER(),0640)) {  my $db = &LONCAPA::locking_hash_tie($fname,&GDBM_WRCREAT());
   if (! $db) {
     warn "Unable to tie to $fname";      warn "Unable to tie to $fname";
     exit;      exit;
 }  }
Line 16  slots can have these parts;: Line 20  slots can have these parts;:
 Required:  Required:
   starttime - unix time that a slot start    starttime - unix time that a slot start
   endtime - unix time that a slot ends    endtime - unix time that a slot ends
       type - either 'preassigned' or 'schedulable_student'
            (controls whether slotrequest.pm will allow one to select it)
   
 Optional:  Optional:
   type - either 'preassigned' or 'scheduleable_student'    startreserve - unix time that a slot can start being reserved
          (controls whether slotrequest.pm will allow one to select it)  
   ip - comma seperated list of ip address or wildcard ranges or    ip - comma seperated list of ip address or wildcard ranges or
        wilcard hostnames, or [] style range of allowable client IP         wilcard hostnames, or [] style range of allowable client IP
        addresses         addresses
Line 29  Optional: Line 33  Optional:
                 this slot                  this slot
   maxspace - integer (number of people that can schedule this space)    maxspace - integer (number of people that can schedule this space)
              (if unspecfied no limit is used)               (if unspecfied no limit is used)
   
 Possibly Need: (but not yet supported)  
   symb - arrayref of symbs that can be scheduled to be done in this slot    symb - arrayref of symbs that can be scheduled to be done in this slot
   uniqperiod - if the user has a reservation that has a uniqpersion    uniqueperiod - if the user has a reservation that has a uniqueperiod
                that overlaps this dn't allow them to schedule this                   that overlaps this don't allow them to schedule this
                reservation                   slot
     secret - arrary ref of words that are the secret for this slot
   Possibly Need: (but not yet supported)
   
   
 =cut  =cut
   
 $db{'slot1'}=  $db->{'slot1'}=
     &freeze_escape({      &Apache::lonnet::freeze_escape({
  'type'      => 'preassigned',   'type'      => 'preassigned',
    'startreserve' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),   'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'endtime'   => &UnixDate("Aug 30th 01:00:00 2004","%s"),   'endtime'   => &UnixDate("Aug 30th 01:00:00 2004","%s"),
  'ip'        => "*albertelli.com",   'ip'        => "*albertelli.com",
  'proctor'   => 'testuser@annarbor',   'proctor'   => 'testuser@annarbor',
     });      });
 $db{'slot2'}=  $db->{'slot2'}=
     &freeze_escape({      &Apache::lonnet::freeze_escape({
  'type'      => 'preassigned',   'type'      => 'preassigned',
  'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),   'startreserve' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
    'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
    #'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
  'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),   'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
    'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'ip'        => "*albertelli.com",   'ip'        => "*albertelli.com",
  'proctor'   => 'testuser@annarbor',   'proctor'   => 'testuser@annarbor',
     });      });
 $db{'slot3'}=  $db->{'slot3'}=
     &freeze_escape({      &Apache::lonnet::freeze_escape({
  'type'      => 'preassigned',   'type'      => 'preassigned',
  'description' => 'slot3',   'description' => 'slot3',
    'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
  'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),   'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),   'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
         'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),          'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'ip'        => "1.2.3.4",   #'ip'        => "1.2.3.4",
  'ip'        => "*albertelli.com",   #'ip'        => "*albertelli.com",
  'proctor'   => 'testuser@annarbor',   'proctor'   => 'testuser@annarbor',
     });      });
 $db{'slot4'}=  $db->{'slot4'}=
     &freeze_escape({      &Apache::lonnet::freeze_escape({
  'type'      => 'preassigned',   'type'      => 'preassigned',
    'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
  'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),   'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),   'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
  'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),   'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'ip'        => "*albertelli.com",   #'ip'        => "*albertelli.com",
  'proctor'   => 'testuser@annarbor',   'proctor'   => 'testuser@annarbor',
     });      });
 $db{'slot5'}=  $db->{'slot5'}=
     &freeze_escape({      &Apache::lonnet::freeze_escape({
  'type'      => 'schedulable_student',   'type'      => 'schedulable_student',
  'description' => 'Aug 30th 4 P.M., Room 123 Kedzie',   'description' => 'Aug 30th 4 P.M., Room 123 Kedzie',
    'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
  'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),   'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),   #'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
    'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
    #'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
  'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),   'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'ip'        => "*albertelli.com",   #'ip'        => "*albertelli.com,"
  'proctor'   => 'testuser@annarbor',   'proctor'   => 'testuser@annarbor',
    'uniqueperiod' => [&UnixDate("Aug 30th 00:00:00 2004","%s"),
      &UnixDate("Aug 30th 00:00:00 2005","%s")],
    'maxspace' => 10,
    'secret'   => 'sauce'
     });      });
 $db{'slot6'}=  $db->{'slot6'}=
     &freeze_escape({      &Apache::lonnet::freeze_escape({
  'type'      => 'schedulable_student',   'type'      => 'schedulable_student',
  'description' => 'Aug 31th 4 P.M., Room 222 Computer Center',   'description' => 'Aug 31th 4 P.M., Room 222 Computer Center',
  'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),   'startreserve' => &UnixDate("Aug 29th 00:00:00 2004","%s"),
    #'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
    'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
  'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),   'endtime'   => &UnixDate("Aug 30th 00:00:00 2006","%s"),
  'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),   #'endtime'   => &UnixDate("Aug 30th 00:00:00 2004","%s"),
  'ip'        => "*albertelli.com",   #'ip'        => "*albertelli.com",
  'proctor'   => 'testuser@annarbor',   'proctor'   => 'testuser@annarbor',
    'uniqueperiod' => [&UnixDate("Aug 1st 00:00:00 2005","%s"),
      &UnixDate("Aug 30th 00:00:00 2006","%s")],
    'maxspace' => 4,
     });      });
   
 sub freeze_escape {  
     my ($value)=@_;  
     if (ref($value)) {  
  $value=&nfreeze($value);  
  return '__FROZEN__'.&escape($value);  
     }  
     return &escape($value);  
 }  
   
 sub escape {  
     my $str=shift;  
     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;  
     return $str;  
 }  
   
 sub thaw_unescape {  
     my ($value)=@_;  
     if ($value =~ /^__FROZEN__/) {  
  substr($value,0,10,undef);  
  $value=&unescape($value);  
  return &thaw($value);  
     }  
     return &unescape($value);  
 }  
   
 sub unescape {  
     my $str=shift;  
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
     return $str;  
 }  
Removed from v.1.3  
changed lines
  Added in v.1.7

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