File:  [LON-CAPA] / loncom / interface / slotrequest.pm
Revision 1.60: download - view: text, annotated - select for diffs
Fri May 12 01:20:31 2006 UTC (18 years, 1 month ago) by albertel
Branches: MAIN
CVS tags: HEAD
- chaning the value from sequence to map to better represent it's scope

    1: # The LearningOnline Network with CAPA
    2: # Handler for requesting to have slots added to a students record
    3: #
    4: # $Id: slotrequest.pm,v 1.60 2006/05/12 01:20:31 albertel Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###
   29: 
   30: package Apache::slotrequest;
   31: 
   32: use strict;
   33: use Apache::Constants qw(:common :http :methods);
   34: use Apache::loncommon();
   35: use Apache::lonlocal;
   36: use Apache::lonnet;
   37: use Apache::lonnavmaps();
   38: use Date::Manip;
   39: 
   40: sub fail {
   41:     my ($r,$code)=@_;
   42:     if ($code eq 'not_valid') {
   43: 	$r->print('<p>'.&mt('Unable to understand what resource you wanted to sign up for.').'</p>');
   44: 
   45:     } elsif ($code eq 'not_allowed') {
   46: 	$r->print('<p>'.&mt('Not allowed to sign up or change reservations at this time.').'</p>');
   47:     } else {
   48: 	$r->print('<p>'.&mt('Failed.').'</p>');
   49:     }
   50:     
   51:     &return_link($r);
   52:     &end_page($r);
   53: }
   54: 
   55: sub start_page {
   56:     my ($r,$title)=@_;
   57:     $r->print(&Apache::loncommon::start_page($title));
   58: }
   59: 
   60: sub end_page {
   61:     my ($r)=@_;
   62:     $r->print(&Apache::loncommon::end_page());
   63: }
   64: 
   65: =pod
   66: 
   67:  slot_reservations db
   68:    - keys are 
   69:     - slotname\0id -> value is an hashref of
   70:                          name -> user@domain of holder
   71:                          timestamp -> timestamp of reservation
   72:                          symb -> symb of resource that it is reserved for
   73: 
   74: =cut
   75: 
   76: sub get_course {
   77:     (undef,my $courseid)=&Apache::lonxml::whichuser();
   78:     my $cdom=$env{'course.'.$courseid.'.domain'};
   79:     my $cnum=$env{'course.'.$courseid.'.num'};
   80:     return ($cnum,$cdom);
   81: }
   82: 
   83: sub get_reservation_ids {
   84:     my ($slot_name)=@_;
   85:     
   86:     my ($cnum,$cdom)=&get_course();
   87: 
   88:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
   89: 				       "^$slot_name\0");
   90:     if (&network_error(%consumed)) { 
   91: 	return 'error: Unable to determine current status';
   92:     }
   93:     my ($tmp)=%consumed;
   94:     if ($tmp=~/^error: 2 / ) {
   95: 	return 0;
   96:     }
   97:     return keys(%consumed);
   98: }
   99: 
  100: sub space_available {
  101:     my ($slot_name,$slot)=@_;
  102:     my $max=$slot->{'maxspace'};
  103: 
  104:     if (!defined($max)) { return 1; }
  105: 
  106:     my $consumed=scalar(&get_reservation_ids($slot_name));
  107:     if ($consumed < $max) {
  108: 	return 1
  109:     }
  110:     return 0;
  111: }
  112: 
  113: sub check_for_reservation {
  114:     my ($symb,$mode)=@_;
  115:     my $student = &Apache::lonnet::EXT("resource.0.availablestudent", $symb,
  116: 				       $env{'user.domain'}, $env{'user.name'});
  117: 
  118:     my $course = &Apache::lonnet::EXT("resource.0.available", $symb,
  119: 				    $env{'user.domain'}, $env{'user.name'});
  120:     my @slots = (split(/:/,$student), split(/:/, $course));
  121: 
  122:     &Apache::lonxml::debug(" slot list is ".join(':',@slots));
  123: 
  124:     my ($cnum,$cdom)=&get_course();
  125:     my %slots=&Apache::lonnet::get('slots', [@slots], $cdom, $cnum);
  126: 
  127:     if (&network_error($student) || &network_error($course)  ||
  128: 	&network_error(%slots)) {
  129: 	return 'error: Unable to determine current status';
  130:     }    
  131:     my @got;
  132:     foreach my $slot_name (sort {
  133: 	if (ref($slots{$a}) && ref($slots{$b})) {
  134: 	    return $slots{$a}{'starttime'} <=> $slots{$b}{'starttime'}
  135: 	}
  136: 	if (ref($slots{$a})) { return -1;}
  137: 	if (ref($slots{$b})) { return 1;}
  138: 	return 0;
  139:     } @slots) {
  140: 	next if (!defined($slots{$slot_name}) ||
  141: 		 !ref($slots{$slot_name}));
  142: 	&Apache::lonxml::debug(time." $slot_name ".
  143: 			       $slots{$slot_name}->{'starttime'}." -- ".
  144: 			       $slots{$slot_name}->{'startreserve'});
  145: 	if ($slots{$slot_name}->{'endtime'} > time &&
  146: 	    $slots{$slot_name}->{'startreserve'} < time) {
  147: 	    # between start of reservation times and end of slot
  148: 	    if ($mode eq 'allslots') {
  149: 		push(@got,$slot_name);
  150: 	    } else {
  151: 		return($slot_name, $slots{$slot_name});
  152: 	    }
  153: 	}
  154:     }
  155:     if ($mode eq 'allslots' && @got) {
  156: 	return @got;
  157:     }
  158:     return (undef,undef);
  159: }
  160: 
  161: sub get_consumed_uniqueperiods {
  162:     my ($slots) = @_;
  163:     my $navmap=Apache::lonnavmaps::navmap->new;
  164:     my @problems = $navmap->retrieveResources(undef,
  165: 					      sub { $_[0]->is_problem() },1,0);
  166:     my %used_slots;
  167:     foreach my $problem (@problems) {
  168: 	my $symb = $problem->symb();
  169: 	my $student = &Apache::lonnet::EXT("resource.0.availablestudent",
  170: 					   $symb, $env{'user.domain'},
  171: 					   $env{'user.name'});
  172: 	my $course =  &Apache::lonnet::EXT("resource.0.available",
  173: 					   $symb, $env{'user.domain'},
  174: 					   $env{'user.name'});
  175: 	if (&network_error($student) || &network_error($course)) {
  176: 	    return 'error: Unable to determine current status';
  177: 	}
  178: 	foreach my $slot (split(/:/,$student), split(/:/, $course)) {
  179: 	    $used_slots{$slot}=1;
  180: 	}
  181:     }
  182: 
  183:     if (!ref($slots)) {
  184: 	my ($cnum,$cdom)=&get_course();
  185: 	my %slots=&Apache::lonnet::get('slots', [keys(%used_slots)], $cdom, $cnum);
  186: 	if (&network_error(%slots)) {
  187: 	    return 'error: Unable to determine current status';
  188: 	}
  189: 	$slots = \%slots;
  190:     }
  191: 
  192:     my %consumed_uniqueperiods;
  193:     foreach my $slot_name (keys(%used_slots)) {
  194: 	next if (!defined($slots->{$slot_name}) ||
  195: 		 !ref($slots->{$slot_name}));
  196: 	
  197:         next if (!defined($slots->{$slot_name}{'uniqueperiod'}) ||
  198: 		 !ref($slots->{$slot_name}{'uniqueperiod'}));
  199: 	$consumed_uniqueperiods{$slot_name} = 
  200: 	    $slots->{$slot_name}{'uniqueperiod'};
  201:     }
  202:     return \%consumed_uniqueperiods;
  203: }
  204: 
  205: sub check_for_conflict {
  206:     my ($symb,$new_slot_name,$new_slot,$slots,$consumed_uniqueperiods)=@_;
  207: 
  208:     if (!defined($new_slot->{'uniqueperiod'})) { return undef; }
  209: 
  210:     if (!ref($consumed_uniqueperiods)) {
  211: 	$consumed_uniqueperiods = &get_consumed_uniqueperiods($slots);
  212: 	if (&network_error(%$consumed_uniqueperiods)) {
  213: 	    return 'error: Unable to determine current status';
  214: 	}
  215:     }
  216:     
  217:     my ($new_uniq_start,$new_uniq_end) = @{$new_slot->{'uniqueperiod'}};
  218:     foreach my $slot_name (keys(%$consumed_uniqueperiods)) {
  219: 	my ($start,$end)=@{$consumed_uniqueperiods->{$slot_name}};
  220: 	if (!
  221: 	    ($start < $new_uniq_start &&  $end < $new_uniq_start) ||
  222: 	    ($start > $new_uniq_end   &&  $end > $new_uniq_end  )) {
  223: 	    return $slot_name;
  224: 	}
  225:     }
  226:     return undef;
  227: 
  228: }
  229: 
  230: sub network_error {
  231:     my ($result) = @_;
  232:     if ($result =~ /^(con_lost|no_such_host|error: [^2])/) {
  233: 	return 1;
  234:     }
  235:     return 0;
  236: }
  237: 
  238: sub make_reservation {
  239:     my ($slot_name,$slot,$symb)=@_;
  240: 
  241:     my ($cnum,$cdom)=&get_course();
  242: 
  243:     my $value=&Apache::lonnet::EXT("resource.0.availablestudent",$symb,
  244: 				   $env{'user.domain'},$env{'user.name'});
  245:     &Apache::lonxml::debug("value is  $value<br />");
  246: 
  247:     my $use_slots = &Apache::lonnet::EXT("resource.0.useslots");
  248:     &Apache::lonxml::debug("use_slots is  $use_slots<br />");
  249: 
  250:     if (&network_error($value) || &network_error($use_slots)) { 
  251: 	return 'error: Unable to determine current status';
  252:     }
  253: 
  254:     my $parm_symb  = $symb;
  255:     my $parm_level = 1;
  256:     if ($use_slots eq 'map') {
  257: 	my ($map) = &Apache::lonnet::decode_symb($symb);
  258: 	$parm_symb = &Apache::lonnet::symbread($map);
  259: 	$parm_level = 2;
  260:     }
  261: 
  262:     foreach my $other_slot (split(/:/, $value)) {
  263: 	if ($other_slot eq $slot_name) {
  264: 	    my %consumed=&Apache::lonnet::dump('slot_reservations', $cdom,
  265: 					       $cnum, "^$slot_name\0");   
  266: 	    if (&network_error($value)) { 
  267: 		return 'error: Unable to determine current status';
  268: 	    }
  269: 	    my $me=$env{'user.name'}.':'.$env{'user.domain'};
  270: 	    foreach my $key (keys(%consumed)) {
  271: 		if ($consumed{$key}->{'name'} eq $me) {
  272: 		    my $num=(split('\0',$key))[1];
  273: 		    return -$num;
  274: 		}
  275: 	    }
  276: 	}
  277:     }
  278: 
  279:     my $max=$slot->{'maxspace'};
  280:     if (!defined($max)) { $max=99999; }
  281: 
  282:     my (@ids)=&get_reservation_ids($slot_name);
  283:     if (&network_error(@ids)) { 
  284: 	return 'error: Unable to determine current status';
  285:     }
  286:     my $last=0;
  287:     foreach my $id (@ids) {
  288: 	my $num=(split('\0',$id))[1];
  289: 	if ($num > $last) { $last=$num; }
  290:     }
  291:     
  292:     my $wanted=$last+1;
  293:     &Apache::lonxml::debug("wanted $wanted<br />");
  294:     if (scalar(@ids) >= $max) {
  295: 	# full up
  296: 	return undef;
  297:     }
  298:     
  299:     my %reservation=('name'      => $env{'user.name'}.':'.$env{'user.domain'},
  300: 		     'timestamp' => time,
  301: 		     'symb'      => $parm_symb);
  302: 
  303:     my $success=&Apache::lonnet::newput('slot_reservations',
  304: 					{"$slot_name\0$wanted" =>
  305: 					     \%reservation},
  306: 					$cdom, $cnum);
  307: 
  308:     if ($success eq 'ok') {
  309: 	my $new_value=$slot_name;
  310: 	if ($value) {
  311: 	    $new_value=$value.':'.$new_value;
  312: 	}
  313: 	my $result=&Apache::lonparmset::storeparm_by_symb($symb,
  314: 						      '0_availablestudent',
  315: 						       $parm_level, $new_value,
  316: 						       'string',
  317: 						       $env{'user.name'},
  318: 					               $env{'user.domain'});
  319: 	&Apache::lonxml::debug("hrrm $result");
  320: 	return $wanted;
  321:     }
  322: 
  323:     # someone else got it
  324:     return undef;
  325: }
  326: 
  327: sub remove_registration {
  328:     my ($r) = @_;
  329:     if ($env{'form.entry'} ne 'remove all') {
  330: 	return &remove_registration_user($r);
  331:     }
  332:     my $slot_name = $env{'form.slotname'};
  333:     my %slot=&Apache::lonnet::get_slot($slot_name);
  334: 
  335:     my ($cnum,$cdom)=&get_course();
  336:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
  337: 				       "^$slot_name\0");
  338:     if (&network_error(%consumed)) {
  339: 	$r->print("<p>".&mt('A network error has occured.').'</p>');
  340: 	return;
  341:     }
  342:     if (!%consumed) {
  343: 	$r->print("<p>".&mt('Slot <tt>[_1]</tt> has no reservations.',
  344: 			    $slot_name)."</p>");
  345: 	return;
  346:     }
  347: 
  348:     my @names = map { $consumed{$_}{'name'} } (sort(keys(%consumed)));
  349:     my $names = join(' ',@names);
  350: 
  351:     my $msg = &mt('Remove all of [_1] from slot [_2]?',$names,$slot_name);
  352:     &remove_registration_confirmation($r,$msg,['entry','slotname']);
  353: }
  354: 
  355: sub remove_registration_user {
  356:     my ($r) = @_;
  357:     
  358:     my $slot_name = $env{'form.slotname'};
  359: 
  360:     my $name = &Apache::loncommon::plainname($env{'form.uname'},
  361: 					     $env{'form.udom'});
  362: 
  363:     my $title = &Apache::lonnet::gettitle($env{'form.symb'});
  364: 
  365:     my $msg = &mt('Remove [_1] from slot [_2] for [_3]',
  366: 		  $name,$slot_name,$title);
  367:     
  368:     &remove_registration_confirmation($r,$msg,['uname','udom','slotname',
  369: 					       'entry','symb']);
  370: }
  371: 
  372: sub remove_registration_confirmation {
  373:     my ($r,$msg,$inputs) =@_;
  374: 
  375:     my $hidden_input;
  376:     foreach my $parm (@{$inputs}) {
  377: 	$hidden_input .=
  378: 	    '<input type="hidden" name="'.$parm.'" value="'
  379: 	    .&HTML::Entities::encode($env{'form.'.$parm},'"<>&\'').'" />'."\n";
  380:     }
  381:     my %lt = &Apache::lonlocal::texthash('yes' => 'Yes',
  382: 					 'no'  => 'No',);
  383:     $r->print(<<"END_CONFIRM");
  384: <p> $msg </p>
  385: <form action="/adm/slotrequest" method="POST">
  386:     <input type="hidden" name="command" value="release" />
  387:     <input type="hidden" name="button" value="yes" />
  388:     $hidden_input
  389:     <input type="submit" value="$lt{'yes'}" />
  390: </form>
  391: <form action="/adm/slotrequest" method="POST">
  392:     <input type="hidden" name="command" value="showslots" />
  393:     <input type="submit" value="$lt{'no'}" />
  394: </form>
  395: END_CONFIRM
  396: 
  397: }
  398: 
  399: sub release_all_slot {
  400:     my ($r,$mgr)=@_;
  401:     
  402:     my $slot_name = $env{'form.slotname'};
  403: 
  404:     my ($cnum,$cdom)=&get_course();
  405: 
  406:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
  407: 				       "^$slot_name\0");
  408:     
  409:     $r->print('<p>'.&mt('Releasing reservations').'</p>');
  410: 
  411:     foreach my $entry (sort { $consumed{$a}{'name'} cmp 
  412: 				  $consumed{$b}{'name'} } (keys(%consumed))) {
  413: 	my ($uname,$udom) = split(':',$consumed{$entry}{'name'});
  414: 	my ($result,$msg) =
  415: 	    &release_reservation($slot_name,$uname,$udom,
  416: 				 $consumed{$entry}{'symb'},$mgr);
  417: 	$r->print("<p>$msg</p>");
  418: 	$r->rflush();
  419:     }
  420:     $r->print('<p><a href="/adm/slotrequest?command=showslots">'.
  421: 	      &mt('Return to slot list').'</a></p>');
  422:     &return_link($r);
  423: }
  424: 
  425: sub release_slot {
  426:     my ($r,$symb,$slot_name,$inhibit_return_link,$mgr)=@_;
  427: 
  428:     if ($slot_name eq '') { $slot_name=$env{'form.slotname'}; }
  429: 
  430:     my ($uname,$udom) = ($env{'user.name'}, $env{'user.domain'});
  431:     if ($mgr eq 'F' 
  432: 	&& defined($env{'form.uname'}) && defined($env{'form.udom'})) {
  433: 	($uname,$udom) = ($env{'form.uname'}, $env{'form.udom'});
  434:     }
  435: 
  436:     if ($mgr eq 'F' 
  437: 	&& defined($env{'form.symb'})) {
  438: 	$symb = $env{'form.symb'};
  439:     }
  440: 
  441:     my ($result,$msg) =
  442: 	&release_reservation($slot_name,$uname,$udom,$symb,$mgr);
  443:     $r->print("<p>$msg</p>");
  444:     
  445:     if ($mgr eq 'F') {
  446: 	$r->print('<p><a href="/adm/slotrequest?command=showslots">'.
  447: 		  &mt('Return to slot list').'</a></p>');
  448:     }
  449: 
  450:     if (!$inhibit_return_link) { &return_link($r);  }
  451:     return $result;
  452: }
  453: 
  454: sub release_reservation {
  455:     my ($slot_name,$uname,$udom,$symb,$mgr) = @_;
  456:     my %slot=&Apache::lonnet::get_slot($slot_name);
  457:     my $description=&get_description($slot_name,\%slot);
  458: 
  459:     if ($mgr ne 'F') {
  460: 	if ($slot{'starttime'} < time) {
  461: 	    return (0,&mt('Not allowed to release Reservation: [_1], as it has already ended.',$description));
  462: 	}
  463:     }
  464:     # get parameter string, check for existance, rebuild string with the slot
  465:     my @slots = split(/:/,&Apache::lonnet::EXT("resource.0.availablestudent",
  466: 					       $symb,$udom,$uname));
  467: 
  468:     my @new_slots;
  469:     foreach my $exist_slot (@slots) {
  470: 	if ($exist_slot eq $slot_name) { next; }
  471: 	push(@new_slots,$exist_slot);
  472:     }
  473:     my $new_param = join(':',@new_slots);
  474: 
  475:     my ($cnum,$cdom)=&get_course();
  476: 
  477:     # get slot reservations, check if user has one, if so remove reservation
  478:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
  479: 				       "^$slot_name\0");
  480:     foreach my $entry (keys(%consumed)) {
  481: 	if ( $consumed{$entry}->{'name'} eq ($uname.':'.$udom) ) {
  482: 	    &Apache::lonnet::del('slot_reservations',[$entry],
  483: 				 $cdom,$cnum);
  484: 	}
  485:     }
  486: 
  487:     my $use_slots = &Apache::lonnet::EXT("resource.0.useslots");
  488:     &Apache::lonxml::debug("use_slots is  $use_slots<br />");
  489: 
  490:     if (&network_error($use_slots)) { 
  491: 	return (0,'error: Unable to determine current status');
  492:     }
  493: 
  494:     my $parm_level = 1;
  495:     if ($use_slots eq 'map') {
  496: 	$parm_level = 2;
  497:     }
  498:     # store new parameter string
  499:     my $result=&Apache::lonparmset::storeparm_by_symb($symb,
  500: 						      '0_availablestudent',
  501: 						      $parm_level, $new_param,
  502: 						      'string', $uname, $udom);
  503: 
  504:     my $msg;
  505:     if ($mgr eq 'F') {
  506: 	$msg = &mt('Released Reservation for user: [_1]',"$uname:$udom");
  507:     } else {
  508: 	$msg = &mt('Released Reservation: [_1]',$description);
  509:     }
  510:     return (1,$msg);
  511: }
  512: 
  513: sub delete_slot {
  514:     my ($r)=@_;
  515: 
  516:     my $slot_name = $env{'form.slotname'};
  517:     my %slot=&Apache::lonnet::get_slot($slot_name);
  518: 
  519:     my ($cnum,$cdom)=&get_course();
  520:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
  521: 				       "^$slot_name\0");
  522:     my ($tmp) = %consumed;
  523:     if ($tmp =~ /error: 2/) { undef(%consumed); }
  524: 
  525:     if (%slot && !%consumed) {
  526: 	$slot{'type'} = 'deleted';
  527: 	my $ret = &Apache::lonnet::cput('slots', {$slot_name => \%slot},
  528: 					$cdom, $cnum);
  529: 	if ($ret eq 'ok') {
  530: 	    $r->print("<p>Slot <tt>$slot_name</tt> marked as deleted.</p>");
  531: 	} else {
  532: 	    $r->print("<p> An error ($ret) occurse when attempting to delete Slot <tt>$slot_name</tt>.</p>");
  533: 	}
  534:     } else {
  535: 	if (%consumed) {
  536: 	    $r->print("<p>Slot <tt>$slot_name</tt> has active reservations.</p>");
  537: 	} else {
  538: 	    $r->print("<p>Slot <tt>$slot_name</tt> does not exist.</p>");
  539: 	}
  540:     }
  541:     $r->print('<p><a href="/adm/slotrequest?command=showslots">'.
  542: 	      &mt('Return to slot list').'</a></p>');
  543:     &return_link($r);
  544: }
  545: 
  546: sub return_link {
  547:     my ($r) = @_;
  548:     $r->print('<p><a href="/adm/flip?postdata=return:">'.
  549: 	      &mt('Return to last resource').'</a></p>');
  550: }
  551: 
  552: sub get_slot {
  553:     my ($r,$symb)=@_;
  554: 
  555:     my %slot=&Apache::lonnet::get_slot($env{'form.slotname'});
  556:     my $slot_name=&check_for_conflict($symb,$env{'form.slotname'},\%slot);
  557: 
  558:     if ($slot_name =~ /^error: (.*)/) {
  559: 	$r->print("<p>An error occured while attempting to make a reservation. ($1)</p>");
  560: 	&return_link($r);
  561: 	return;
  562:     }
  563:     if ($slot_name) {
  564: 	my %slot=&Apache::lonnet::get_slot($slot_name);
  565: 	my $description1=&get_description($slot_name,\%slot);
  566: 	%slot=&Apache::lonnet::get_slot($env{'form.slotname'});
  567: 	my $description2=&get_description($env{'form.slotname'},\%slot);
  568: 	$r->print("<p>Already have a reservation: $description1</p>");
  569: 	if ($slot_name ne $env{'form.slotname'}) {
  570: 	    $r->print(<<STUFF);
  571: <form method="POST" action="/adm/slotrequest">
  572:    <input type="hidden" name="symb" value="$env{'form.symb'}" />
  573:    <input type="hidden" name="slotname" value="$env{'form.slotname'}" />
  574:    <input type="hidden" name="releaseslot" value="$slot_name" />
  575:    <input type="hidden" name="command" value="change" />
  576: STUFF
  577:             $r->print("<p>You can either ");
  578: 	    $r->print(<<STUFF);
  579:    <input type="submit" name="change" value="Change" />
  580: STUFF
  581: 	    $r->print(' your reservation from <b>'.$description1.'</b> to <b>'.
  582: 		      $description2.
  583: 		      '</b> <br />or </p>');
  584: 	    &return_link($r);
  585: 	    $r->print(<<STUFF);
  586: </form>
  587: STUFF
  588:         } else {
  589: 	    &return_link($r);
  590: 	}
  591: 	return;
  592:     }
  593: 
  594:     my $reserved=&make_reservation($env{'form.slotname'},
  595: 				   \%slot,$symb);
  596:     my $description=&get_description($env{'form.slotname'},\%slot);
  597:     if (defined($reserved)) {
  598: 	if ($slot_name =~ /^error: (.*)/) {
  599: 	    $r->print("<p>An error occured while attempting to make a reservation. ($1)</p>");
  600: 	} elsif ($reserved > -1) {
  601: 	    $r->print("<p>Success: $description</p>");
  602: 	} elsif ($reserved < 0) {
  603: 	    $r->print("<p>Already reserved: $description</p>");
  604: 	}
  605: 	&return_link($r);
  606: 	return;
  607:     }
  608: 
  609:     my %lt=('request'=>"Availibility list",
  610: 	    'try'    =>'Try again');
  611:     %lt=&Apache::lonlocal::texthash(%lt);
  612: 
  613:     $r->print(<<STUFF);
  614: <p> <font color="red">Failed</font> to reserve a spot for $description. </p>
  615: <p>
  616: <form method="POST" action="/adm/slotrequest">
  617:    <input type="submit" name="Try Again" value="$lt{'try'}" />
  618:    <input type="hidden" name="symb" value="$env{'form.symb'}" />
  619:    <input type="hidden" name="slotname" value="$env{'form.slotname'}" />
  620:    <input type="hidden" name="command" value="get" />
  621: </form>
  622: ?
  623: </p>
  624: <p>
  625: or
  626: <form method="POST" action="/adm/slotrequest">
  627:     <input type="hidden" name="symb" value="$env{'form.symb'}" />
  628:     <input type="submit" name="requestattempt" value="$lt{'request'}" />
  629: </form>
  630: </p>
  631: or
  632: STUFF
  633: 
  634:     &return_link($r);
  635:     return;
  636: }
  637: 
  638: sub allowed_slot {
  639:     my ($slot_name,$slot,$symb,$slots,$consumed_uniqueperiods)=@_;
  640: 
  641:     #already started
  642:     if ($slot->{'starttime'} < time) {
  643: 	# all open slot to be schedulable
  644: 	#return 0;
  645:     }
  646:     &Apache::lonxml::debug("$slot_name starttime good");
  647: 
  648:     #already ended
  649:     if ($slot->{'endtime'} < time) {
  650: 	return 0;
  651:     }
  652:     &Apache::lonxml::debug("$slot_name endtime good");
  653: 
  654:     # not allowed to pick this one
  655:     if (defined($slot->{'type'})
  656: 	&& $slot->{'type'} ne 'schedulable_student') {
  657: 	return 0;
  658:     }
  659:     &Apache::lonxml::debug("$slot_name type good");
  660: 
  661:     # reserve time not yet started
  662:     if ($slot->{'startreserve'} > time) {
  663: 	return 0;
  664:     }
  665:     &Apache::lonxml::debug("$slot_name reserve good");
  666: 
  667:     my $userallowed=0;
  668:     # its for a different set of users
  669:     if (defined($slot->{'allowedsections'})) {
  670: 	if (!defined($env{'request.role.sec'})
  671: 	    && grep(/^No section assigned$/,
  672: 		    split(',',$slot->{'allowedsections'}))) {
  673: 	    $userallowed=1;
  674: 	}
  675: 	if (defined($env{'request.role.sec'})
  676: 	    && grep(/^\Q$env{'request.role.sec'}\E$/,
  677: 		    split(',',$slot->{'allowedsections'}))) {
  678: 	    $userallowed=1;
  679: 	}
  680:     }
  681:     &Apache::lonxml::debug("$slot_name sections is $userallowed");
  682: 
  683:     # its for a different set of users
  684:     if (defined($slot->{'allowedusers'})
  685: 	&& grep(/^\Q$env{'user.name'}:$env{'user.domain'}\E$/,
  686: 		split(',',$slot->{'allowedusers'}))) {
  687: 	$userallowed=1;
  688:     }
  689: 
  690:     if (!defined($slot->{'allowedusers'})
  691: 	&& !defined($slot->{'allowedsections'})) {
  692: 	$userallowed=1;
  693:     }
  694: 
  695:     &Apache::lonxml::debug("$slot_name user is $userallowed");
  696:     return 0 if (!$userallowed);
  697: 
  698:     # not allowed for this resource
  699:     if (defined($slot->{'symb'})
  700: 	&& $slot->{'symb'} ne $symb) {
  701: 	return 0;
  702:     }
  703: 
  704:     my $conflict = &check_for_conflict($symb,$slot_name,$slot,$slots,
  705: 				       $consumed_uniqueperiods);
  706:     if ($conflict) {
  707: 	if ($slots->{$conflict}{'starttime'} < time) {
  708: 	    return 0;
  709: 	}
  710:     }
  711:     &Apache::lonxml::debug("$slot_name symb good");
  712:     return 1;
  713: }
  714: 
  715: sub get_description {
  716:     my ($slot_name,$slot)=@_;
  717:     my $description=$slot->{'description'};
  718:     if (!defined($description)) {
  719: 	$description=&mt('[_1] From [_2] to [_3]',$slot_name,
  720: 			 &Apache::lonlocal::locallocaltime($slot->{'starttime'}),
  721: 			 &Apache::lonlocal::locallocaltime($slot->{'endtime'}));
  722:     }
  723:     return $description;
  724: }
  725: 
  726: sub show_choices {
  727:     my ($r,$symb)=@_;
  728: 
  729:     my ($cnum,$cdom)=&get_course();
  730:     my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);
  731:     my $consumed_uniqueperiods = &get_consumed_uniqueperiods(\%slots);
  732:     my $available;
  733:     $r->print('<table border="1">');
  734:     &Apache::lonxml::debug("Checking Slots");
  735:     my @got_slots=&check_for_reservation($symb,'allslots');
  736:     foreach my $slot (sort 
  737: 		      { return $slots{$a}->{'starttime'} <=> $slots{$b}->{'starttime'} }
  738: 		      (keys(%slots)))  {
  739: 
  740: 	&Apache::lonxml::debug("Checking Slot $slot");
  741: 	next if (!&allowed_slot($slot,$slots{$slot},undef,\%slots,
  742: 				$consumed_uniqueperiods));
  743: 
  744: 	$available++;
  745: 
  746: 	my $description=&get_description($slot,$slots{$slot});
  747: 
  748: 	my $form=&mt('Unavailable');
  749: 	if ((grep(/^\Q$slot\E$/,@got_slots)) ||
  750: 	    &space_available($slot,$slots{$slot},$symb)) {
  751: 	    my $text=&mt('Select');
  752: 	    my $command='get';
  753: 	    if (grep(/^\Q$slot\E$/,@got_slots)) {
  754: 		$text=&mt('Free Reservation');
  755: 		$command='release';
  756: 	    } else {
  757: 		my $conflict = &check_for_conflict($symb,$slot,$slots{$slot},
  758: 						   \%slots,
  759: 						   $consumed_uniqueperiods);
  760: 		if ($conflict) {
  761: 		    $text=&mt('Change Reservation');
  762: 		    $command='get';
  763: 		}
  764: 	    }
  765: 	    my $escsymb=&Apache::lonnet::escape($symb);
  766: 	    $form=<<STUFF;
  767:    <form method="POST" action="/adm/slotrequest">
  768:      <input type="submit" name="Select" value="$text" />
  769:      <input type="hidden" name="symb" value="$escsymb" />
  770:      <input type="hidden" name="slotname" value="$slot" />
  771:      <input type="hidden" name="command" value="$command" />
  772:    </form>
  773: STUFF
  774: 	}
  775: 	$r->print(<<STUFF);
  776: <tr>
  777:  <td>$form</td>
  778:  <td>$description</td>
  779: </tr>
  780: STUFF
  781:     }
  782: 
  783:     if (!$available) {
  784: 	$r->print('<tr><td>No available times. <a href="/adm/flip?postdata=return:">'.
  785: 		  &mt('Return to last resource').'</a></td></tr>');
  786:     }
  787:     $r->print('</table>');
  788: }
  789: 
  790: sub to_show {
  791:     my ($slotname,$slot,$when,$deleted,$name) = @_;
  792:     my $time=time;
  793:     my $week=60*60*24*7;
  794: 
  795:     if ($deleted eq 'hide' && $slot->{'type'} eq 'deleted') {
  796: 	return 0;
  797:     }
  798: 
  799:     if ($name && $name->{'value'} =~ /\w/) {
  800: 	if ($name->{'type'} eq 'substring') {
  801: 	    if ($slotname !~ /\Q$name->{'value'}\E/) {
  802: 		return 0;
  803: 	    }
  804: 	}
  805: 	if ($name->{'type'} eq 'exact') {
  806: 	    if ($slotname eq $name->{'value'}) {
  807: 		return 0;
  808: 	    }
  809: 	}
  810:     }
  811: 
  812:     if ($when eq 'any') {
  813: 	return 1;
  814:     } elsif ($when eq 'now') {
  815: 	if ($time > $slot->{'starttime'} &&
  816: 	    $time < $slot->{'endtime'}) {
  817: 	    return 1;
  818: 	}
  819: 	return 0;
  820:     } elsif ($when eq 'nextweek') {
  821: 	if ( ($time        < $slot->{'starttime'} &&
  822: 	      ($time+$week) > $slot->{'starttime'})
  823: 	     ||
  824: 	     ($time        < $slot->{'endtime'} &&
  825: 	      ($time+$week) > $slot->{'endtime'}) ) {
  826: 	    return 1;
  827: 	}
  828: 	return 0;
  829:     } elsif ($when eq 'lastweek') {
  830: 	if ( ($time        > $slot->{'starttime'} &&
  831: 	      ($time-$week) < $slot->{'starttime'})
  832: 	     ||
  833: 	     ($time        > $slot->{'endtime'} &&
  834: 	      ($time-$week) < $slot->{'endtime'}) ) {
  835: 	    return 1;
  836: 	}
  837: 	return 0;
  838:     } elsif ($when eq 'willopen') {
  839: 	if ($time < $slot->{'starttime'}) {
  840: 	    return 1;
  841: 	}
  842: 	return 0;
  843:     } elsif ($when eq 'wereopen') {
  844: 	if ($time > $slot->{'endtime'}) {
  845: 	    return 1;
  846: 	}
  847: 	return 0;
  848:     }
  849:     
  850:     return 1;
  851: }
  852: 
  853: sub remove_link {
  854:     my ($slotname,$entry,$uname,$udom,$symb) = @_;
  855: 
  856:     my $remove = &mt('Remove');
  857: 
  858:     if ($entry eq 'remove all') {
  859: 	$remove = &mt('Remove All');
  860: 	undef($uname);
  861: 	undef($udom);
  862:     }
  863: 
  864:     $slotname  = &Apache::lonnet::escape($slotname);
  865:     $entry     = &Apache::lonnet::escape($entry);
  866:     $uname     = &Apache::lonnet::escape($uname);
  867:     $udom      = &Apache::lonnet::escape($udom);
  868:     $symb      = &Apache::lonnet::escape($symb);
  869: 
  870:     return <<"END_LINK";
  871:  <a href="/adm/slotrequest?command=remove_registration&slotname=$slotname&entry=$entry&uname=$uname&udom=$udom&symb=$symb"
  872:    >($remove)</a>
  873: END_LINK
  874: 
  875: }
  876: 
  877: sub show_table {
  878:     my ($r,$mgr)=@_;
  879: 
  880:     my ($cnum,$cdom)=&get_course();
  881:     my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);
  882:     if ( (keys(%slots))[0] =~ /^error: 2 /) {
  883: 	undef(%slots);
  884:     } 
  885:     my $available;
  886:     if ($mgr eq 'F') {
  887: 	$r->print('<div>');
  888: 	$r->print('<form method="POST" action="/adm/slotrequest">
  889: <input type="hidden" name="command" value="uploadstart" />
  890: <input type="submit" name="start" value="'.&mt('Upload Slot List').'" />
  891: </form>');
  892: 	$r->print('<form method="POST" action="/adm/helper/newslot.helper">
  893: <input type="submit" name="newslot" value="'.&mt('Create a New Slot').'" />
  894: </form>');
  895: 	$r->print('</div>');
  896:     }
  897:     
  898:     my %Saveable_Parameters = ('show'              => 'array',
  899: 			       'when'              => 'scalar',
  900: 			       'order'             => 'scalar',
  901: 			       'deleted'           => 'scalar',
  902: 			       'name_filter_type'  => 'scalar',
  903: 			       'name_filter_value' => 'scalar',
  904: 			       );
  905:     &Apache::loncommon::store_course_settings('slotrequest',
  906: 					      \%Saveable_Parameters);
  907:     &Apache::loncommon::restore_course_settings('slotrequest',
  908: 						\%Saveable_Parameters);
  909:     &Apache::grades::init_perm();
  910:     my ($classlist,$section,$fullname)=&Apache::grades::getclasslist('all');
  911:     &Apache::grades::reset_perm();
  912: 
  913:     # what to display filtering
  914:     my %show_fields=&Apache::lonlocal::texthash(
  915: 	     'name'            => 'Slot Name',
  916: 	     'description'     => 'Description',
  917: 	     'type'            => 'Type',
  918: 	     'starttime'       => 'Start time',
  919: 	     'endtime'         => 'End Time',
  920:              'startreserve'    => 'Time students can start reserving',
  921: 	     'secret'          => 'Secret Word',
  922: 	     'maxspace'        => 'Maximum # of students',
  923: 	     'ip'              => 'IP or DNS restrictions',
  924: 	     'symb'            => 'Resource slot is restricted to.',
  925: 	     'allowedsections' => 'Sections slot is restricted to.',
  926: 	     'allowedusers'    => 'Users slot is restricted to.',
  927: 	     'uniqueperiod'    => 'Period of time slot is unique',
  928: 	     'scheduled'       => 'Scheduled Students',
  929: 	     'proctor'         => 'List of proctors');
  930:     my @show_order=('name','description','type','starttime','endtime',
  931: 		    'startreserve','secret','maxspace','ip','symb',
  932: 		    'allowedsections','allowedusers','uniqueperiod',
  933: 		    'scheduled','proctor');
  934:     my @show = 
  935: 	(exists($env{'form.show'})) ? &Apache::loncommon::get_env_multiple('form.show')
  936: 	                            : keys(%show_fields);
  937:     my %show =  map { $_ => 1 } (@show);
  938: 
  939:     #when filtering setup
  940:     my %when_fields=&Apache::lonlocal::texthash(
  941: 	     'now'      => 'Open now',
  942: 	     'nextweek' => 'Open within the next week',
  943: 	     'lastweek' => 'Were open last week',
  944: 	     'willopen' => 'Will open later',
  945: 	     'wereopen' => 'Were open',
  946: 	     'any'      => 'Anytime',
  947: 						);
  948:     my @when_order=('any','now','nextweek','lastweek','willopen','wereopen');
  949:     $when_fields{'select_form_order'} = \@when_order;
  950:     my $when = 	(exists($env{'form.when'})) ? $env{'form.when'}
  951:                                             : 'now';
  952: 
  953:     #display of students setup
  954:     my %stu_display_fields=
  955: 	&Apache::lonlocal::texthash('username' => 'User name',
  956: 				    'fullname' => 'Full name',
  957: 				    );
  958:     my @stu_display_order=('fullname','username');
  959:     my @stu_display = 
  960: 	(exists($env{'form.studisplay'})) ? &Apache::loncommon::get_env_multiple('form.studisplay')
  961: 	                                  : keys(%stu_display_fields);
  962:     my %stu_display =  map { $_ => 1 } (@stu_display);
  963: 
  964:     #name filtering setup
  965:     my %name_filter_type_fields=
  966: 	&Apache::lonlocal::texthash('substring' => 'Substring',
  967: 				    'exact'     => 'Exact',
  968: 				    #'reg'       => 'Regular Expression',
  969: 				    );
  970:     my @name_filter_type_order=('substring','exact');
  971: 
  972:     $name_filter_type_fields{'select_form_order'} = \@name_filter_type_order;
  973:     my $name_filter_type = 
  974: 	(exists($env{'form.name_filter_type'})) ? $env{'form.name_filter_type'}
  975:                                                 : 'substring';
  976:     my $name_filter = {'type'  => $name_filter_type,
  977: 		       'value' => $env{'form.name_filter_value'},};
  978: 
  979:     #deleted slot filtering
  980:     my $hide_radio = 
  981: 	&Apache::lonhtmlcommon::radio('deleted',$env{'form.deleted'},'hide');
  982:     my $show_radio = 
  983: 	&Apache::lonhtmlcommon::radio('deleted',$env{'form.deleted'},'show');
  984: 	
  985:     $r->print('<form method="POST" action="/adm/slotrequest">
  986: <input type="hidden" name="command" value="showslots" />');
  987:     $r->print('<div>');
  988:     $r->print('<table class="inline">
  989:       <tr><th>'.&mt('Show').'</th>
  990:           <th>'.&mt('Student Display').'</th>
  991:           <th>'.&mt('Open').'</th>
  992:           <th>'.&mt('Slot Name Filter').'</th>
  993:           <th>'.&mt('Options').'</th>
  994:       </tr>
  995:       <tr><td>'.&Apache::loncommon::multiple_select_form('show',\@show,6,\%show_fields,\@show_order).
  996: 	      '</td>
  997:            <td>
  998:          '.&Apache::loncommon::multiple_select_form('studisplay',\@stu_display,
  999: 						    6,\%stu_display_fields,
 1000: 						    \@stu_display_order).'
 1001:            </td>
 1002:            <td>'.&Apache::loncommon::select_form($when,'when',%when_fields).
 1003:           '</td>
 1004:            <td>'.&Apache::loncommon::select_form($name_filter_type,
 1005: 						 'name_filter_type',
 1006: 						 %name_filter_type_fields).
 1007: 	      '<br />'.
 1008: 	      &Apache::lonhtmlcommon::textbox('name_filter_value',
 1009: 					      $env{'form.name_filter_value'},
 1010: 					      15).
 1011:           '</td>
 1012:            <td>
 1013:             <table>
 1014:               <tr>
 1015:                 <td rowspan="2">Deleted slots:</td>
 1016:                 <td><label>'.$show_radio.'Show</label></td>
 1017:               </tr>
 1018:               <tr>
 1019:                 <td><label>'.$hide_radio.'Hide</label></td>
 1020:               </tr>
 1021:             </table>
 1022: 	  </td>
 1023:        </tr>
 1024:     </table>');
 1025:     $r->print('</div>');
 1026:     $r->print('<p><input type="submit" name="start" value="'.&mt('Update Display').'" /></p>');
 1027:     my $linkstart='<a href="/adm/slotrequest?command=showslots&amp;order=';
 1028:     $r->print('<table class="thinborder">
 1029: <tr>
 1030:   <th></th>');
 1031:     foreach my $which (@show_order) {
 1032: 	if ($which ne 'proctor' && exists($show{$which})) {
 1033: 	    $r->print('<th>'.$linkstart.$which.'">'.$show_fields{$which}.'</a></th>');
 1034: 	}
 1035:     }
 1036: 
 1037:     my %name_cache;
 1038:     my $slotsort = sub {
 1039: 	if ($env{'form.order'}=~/^(type|description|endtime|startreserve|maxspace|ip|symb|allowedsections|allowedusers)$/) {
 1040: 	    if (lc($slots{$a}->{$env{'form.order'}})
 1041: 		ne lc($slots{$b}->{$env{'form.order'}})) {
 1042: 		return (lc($slots{$a}->{$env{'form.order'}}) 
 1043: 			cmp lc($slots{$b}->{$env{'form.order'}}));
 1044: 	    }
 1045: 	} elsif ($env{'form.order'} eq 'name') {
 1046: 	    if (lc($a) cmp lc($b)) {
 1047: 		return lc($a) cmp lc($b);
 1048: 	    }
 1049: 	} elsif ($env{'form.order'} eq 'uniqueperiod') {
 1050: 	    
 1051: 	    if ($slots{$a}->{'uniqueperiod'}[0] 
 1052: 		ne $slots{$b}->{'uniqueperiod'}[0]) {
 1053: 		return ($slots{$a}->{'uniqueperiod'}[0]
 1054: 			cmp $slots{$b}->{'uniqueperiod'}[0]);
 1055: 	    }
 1056: 	    if ($slots{$a}->{'uniqueperiod'}[1] 
 1057: 		ne $slots{$b}->{'uniqueperiod'}[1]) {
 1058: 		return ($slots{$a}->{'uniqueperiod'}[1]
 1059: 			cmp $slots{$b}->{'uniqueperiod'}[1]);
 1060: 	    }
 1061: 	}
 1062: 	return $slots{$a}->{'starttime'} <=> $slots{$b}->{'starttime'};
 1063:     };
 1064:     foreach my $slot (sort $slotsort (keys(%slots)))  {
 1065: 	if (!&to_show($slot,$slots{$slot},$when,
 1066: 		      $env{'form.deleted'},$name_filter)) { next; }
 1067: 	if (defined($slots{$slot}->{'type'})
 1068: 	    && $slots{$slot}->{'type'} ne 'schedulable_student') {
 1069: 	    #next;
 1070: 	}
 1071: 	my $description=&get_description($slot,$slots{$slot});
 1072: 	my $ids;
 1073: 	if (exists($show{'scheduled'})) {
 1074: 	    my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
 1075: 					       "^$slot\0");
 1076: 	    my ($tmp)=%consumed;
 1077: 	    if ($tmp !~ /^error: /) {
 1078: 		foreach my $entry (sort { $consumed{$a}{name} cmp 
 1079: 					      $consumed{$b}{name} }
 1080: 				   (keys(%consumed))) {
 1081: 		    my (undef,$id)=split("\0",$entry);
 1082: 		    my ($uname,$udom) = split(':',$consumed{$entry}{'name'});
 1083: 		    $ids.= '<nobr>';
 1084: 		    foreach my $item (@stu_display_order) {
 1085: 			if ($stu_display{$item}) {
 1086: 			    if ($item eq 'fullname') {
 1087: 				$ids.=$fullname->{"$uname:$udom"}.' ';
 1088: 			    } elsif ($item eq 'username') {
 1089: 				$ids.="<tt>$uname:$udom</tt> ";
 1090: 			    }
 1091: 			}
 1092: 		    }
 1093: 		    $ids.=&remove_link($slot,$entry,$uname,$udom,
 1094: 				       $consumed{$entry}{'symb'}).'</nobr><br />';
 1095: 		}
 1096: 	    }
 1097: 	}
 1098: 
 1099: 	my $start=($slots{$slot}->{'starttime'}?
 1100: 		   &Apache::lonlocal::locallocaltime($slots{$slot}->{'starttime'}):'');
 1101: 	my $end=($slots{$slot}->{'endtime'}?
 1102: 		 &Apache::lonlocal::locallocaltime($slots{$slot}->{'endtime'}):'');
 1103: 	my $start_reserve=($slots{$slot}->{'startreserve'}?
 1104: 			   &Apache::lonlocal::locallocaltime($slots{$slot}->{'startreserve'}):'');
 1105: 	
 1106: 	my $unique;
 1107: 	if (ref($slots{$slot}{'uniqueperiod'})) {
 1108: 	    $unique=localtime($slots{$slot}{'uniqueperiod'}[0]).','.
 1109: 		localtime($slots{$slot}{'uniqueperiod'}[1]);
 1110: 	}
 1111: 
 1112: 	my $title;
 1113: 	if (exists($slots{$slot}{'symb'})) {
 1114: 	    my (undef,undef,$res)=
 1115: 		&Apache::lonnet::decode_symb($slots{$slot}{'symb'});
 1116: 	    $res =   &Apache::lonnet::clutter($res);
 1117: 	    $title = &Apache::lonnet::gettitle($slots{$slot}{'symb'});
 1118: 	    $title='<a href="'.$res.'?symb='.$slots{$slot}{'symb'}.'">'.$title.'</a>';
 1119: 	}
 1120: 
 1121: 	my $allowedsections;
 1122: 	if (exists($show{'allowedsections'})) {
 1123: 	    $allowedsections = 
 1124: 		join(', ',sort(split(/\s*,\s*/,
 1125: 				     $slots{$slot}->{'allowedsections'})));
 1126: 	}
 1127: 
 1128: 	my @allowedusers;
 1129: 	if (exists($show{'allowedusers'})) {
 1130: 	    @allowedusers= map {
 1131: 		my ($uname,$udom)=split(/:/,$_);
 1132: 		my $fullname=$name_cache{$_};
 1133: 		if (!defined($fullname)) {
 1134: 		    $fullname = &Apache::loncommon::plainname($uname,$udom);
 1135: 		    $fullname =~s/\s/&nbsp;/g;
 1136: 		    $name_cache{$_} = $fullname;
 1137: 		}
 1138: 		&Apache::loncommon::aboutmewrapper($fullname,$uname,$udom);
 1139: 	    } (sort(split(/\s*,\s*/,$slots{$slot}->{'allowedusers'})));
 1140: 	}
 1141: 	my $allowedusers=join(', ',@allowedusers);
 1142: 	
 1143: 	my @proctors;
 1144: 	my $rowspan=1;
 1145: 	my $colspan=1;
 1146: 	if (exists($show{'proctor'})) {
 1147: 	    $rowspan=2;
 1148: 	    @proctors= map {
 1149: 		my ($uname,$udom)=split(/@/,$_);
 1150: 		my $fullname=$name_cache{$_};
 1151: 		if (!defined($fullname)) {
 1152: 		    $fullname = &Apache::loncommon::plainname($uname,$udom);
 1153: 		    $fullname =~s/\s/&nbsp;/g;
 1154: 		    $name_cache{$_} = $fullname;
 1155: 		}
 1156: 		&Apache::loncommon::aboutmewrapper($fullname,$uname,$udom);
 1157: 	    } (sort(split(/\s*,\s*/,$slots{$slot}->{'proctor'})));
 1158: 	}
 1159: 	my $proctors=join(', ',@proctors);
 1160: 
 1161: 	my $edit=(<<"EDITLINK");
 1162: <a href="/adm/helper/newslot.helper?name=$slot">Edit</a>
 1163: EDITLINK
 1164: 
 1165: 	my $delete=(<<"DELETELINK");
 1166: <a href="/adm/slotrequest?command=delete&slotname=$slot">Delete</a>
 1167: DELETELINK
 1168: 
 1169:         my $remove_all=&remove_link($slot,'remove all').'<br />';
 1170: 
 1171:         if ($ids ne '') { undef($delete); }
 1172: 	if ($slots{$slot}{'type'} ne 'schedulable_student' 
 1173: 	    || $ids eq '') { 
 1174: 	    undef($remove_all);
 1175: 	}
 1176: 
 1177:         $r->print("<tr>\n<td rowspan=\"$rowspan\">$edit $delete</td>\n");
 1178: 	if (exists($show{'name'})) {
 1179: 	    $colspan++;$r->print("<td>$slot</td>");
 1180: 	}
 1181: 	if (exists($show{'description'})) {
 1182: 	    $colspan++;$r->print("<td>$description</td>\n");
 1183: 	}
 1184: 	if (exists($show{'type'})) {
 1185: 	    $colspan++;$r->print("<td>$slots{$slot}->{'type'}</td>\n");
 1186: 	}
 1187: 	if (exists($show{'starttime'})) {
 1188: 	    $colspan++;$r->print("<td>$start</td>\n");
 1189: 	}
 1190: 	if (exists($show{'endtime'})) {
 1191: 	    $colspan++;$r->print("<td>$end</td>\n");
 1192: 	}
 1193: 	if (exists($show{'startreserve'})) {
 1194: 	    $colspan++;$r->print("<td>$start_reserve</td>\n");
 1195: 	}
 1196: 	if (exists($show{'secret'})) {
 1197: 	    $colspan++;$r->print("<td>$slots{$slot}{'secret'}</td>\n");
 1198: 	}
 1199: 	if (exists($show{'maxspace'})) {
 1200: 	    $colspan++;$r->print("<td>$slots{$slot}{'maxspace'}</td>\n");
 1201: 	}
 1202: 	if (exists($show{'ip'})) {
 1203: 	    $colspan++;$r->print("<td>$slots{$slot}{'ip'}</td>\n");
 1204: 	}
 1205: 	if (exists($show{'symb'})) {
 1206: 	    $colspan++;$r->print("<td>$title</td>\n");
 1207: 	}
 1208: 	if (exists($show{'allowedsections'})) {
 1209: 	    $colspan++;$r->print("<td>$allowedsections</td>\n");
 1210: 	}
 1211: 	if (exists($show{'allowedusers'})) {
 1212: 	    $colspan++;$r->print("<td>$allowedusers</td>\n");
 1213: 	}
 1214: 	if (exists($show{'scheduled'})) {
 1215: 	    $colspan++;$r->print("<td>$remove_all $ids</td>\n</tr>\n");
 1216: 	}
 1217: 	if (exists($show{'proctor'})) {
 1218: 	    $r->print(<<STUFF);
 1219: <tr>
 1220:  <td colspan="$colspan">$proctors</td>
 1221: </tr>
 1222: STUFF
 1223:         }
 1224:     }
 1225:     $r->print('</table>');
 1226: }
 1227: 
 1228: sub upload_start {
 1229:     my ($r)=@_;    
 1230:     $r->print(&Apache::grades::checkforfile_js());
 1231:     my $result.='<table width=100% border=0><tr bgcolor="#e6ffff"><td>'."\n";
 1232:     $result.='&nbsp;<b>'.
 1233: 	&mt('Specify a file containing the slot definitions.').
 1234: 	'</b></td></tr>'."\n";
 1235:     $result.='<tr bgcolor=#ffffe6><td>'."\n";
 1236:     my $upfile_select=&Apache::loncommon::upfile_select_html();
 1237:     my $ignore=&mt('Ignore First Line');
 1238:     $result.=<<ENDUPFORM;
 1239: <form method="post" enctype="multipart/form-data" action="/adm/slotrequest" name="slotupload">
 1240: <input type="hidden" name="command" value="csvuploadmap" />
 1241: $upfile_select
 1242: <br /><input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Data" />
 1243: <label><input type="checkbox" name="noFirstLine" />$ignore</label>
 1244: </form>
 1245: ENDUPFORM
 1246:     $result.='</td></tr></table>'."\n";
 1247:     $result.='</td></tr></table>'."\n";
 1248:     $r->print($result);
 1249: }
 1250: 
 1251: sub csvuploadmap_header {
 1252:     my ($r,$datatoken,$distotal)= @_;
 1253:     my $javascript;
 1254:     if ($env{'form.upfile_associate'} eq 'reverse') {
 1255: 	$javascript=&csvupload_javascript_reverse_associate();
 1256:     } else {
 1257: 	$javascript=&csvupload_javascript_forward_associate();
 1258:     }
 1259: 
 1260:     my $checked=(($env{'form.noFirstLine'})?' checked="checked"':'');
 1261:     my $ignore=&mt('Ignore First Line');
 1262:     $r->print(<<ENDPICK);
 1263: <form method="post" enctype="multipart/form-data" action="/adm/slotrequest" name="slotupload">
 1264: <h3>Identify fields</h3>
 1265: Total number of records found in file: $distotal <hr />
 1266: Enter as many fields as you can. The system will inform you and bring you back
 1267: to this page if the data selected is insufficient to create the slots.<hr />
 1268: <input type="button" value="Reverse Association" onClick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" />
 1269: <label><input type="checkbox" name="noFirstLine" $checked />$ignore</label>
 1270: <input type="hidden" name="associate"  value="" />
 1271: <input type="hidden" name="datatoken"  value="$datatoken" />
 1272: <input type="hidden" name="fileupload" value="$env{'form.fileupload'}" />
 1273: <input type="hidden" name="upfiletype" value="$env{'form.upfiletype'}" />
 1274: <input type="hidden" name="upfile_associate" 
 1275:                                        value="$env{'form.upfile_associate'}" />
 1276: <input type="hidden" name="command"    value="csvuploadassign" />
 1277: <hr />
 1278: <script type="text/javascript" language="Javascript">
 1279: $javascript
 1280: </script>
 1281: ENDPICK
 1282:     return '';
 1283: 
 1284: }
 1285: 
 1286: sub csvuploadmap_footer {
 1287:     my ($request,$i,$keyfields) =@_;
 1288:     $request->print(<<ENDPICK);
 1289: </table>
 1290: <input type="hidden" name="nfields" value="$i" />
 1291: <input type="hidden" name="keyfields" value="$keyfields" />
 1292: <input type="button" onClick="javascript:verify(this.form)" value="Create Slots" /><br />
 1293: </form>
 1294: ENDPICK
 1295: }
 1296: 
 1297: sub csvupload_javascript_reverse_associate {
 1298:     my $error1=&mt('You need to specify the name, starttime, endtime and a type');
 1299:     return(<<ENDPICK);
 1300:   function verify(vf) {
 1301:     var foundstart=0;
 1302:     var foundend=0;
 1303:     var foundname=0;
 1304:     var foundtype=0;
 1305:     for (i=0;i<=vf.nfields.value;i++) {
 1306:       tw=eval('vf.f'+i+'.selectedIndex');
 1307:       if (i==0 && tw!=0) { foundname=1; }
 1308:       if (i==1 && tw!=0) { foundtype=1; }
 1309:       if (i==2 && tw!=0) { foundstat=1; }
 1310:       if (i==3 && tw!=0) { foundend=1; }
 1311:     }
 1312:     if (foundstart==0 && foundend==0 && foundtype==0 && foundname==0) {
 1313: 	alert('$error1');
 1314: 	return;
 1315:     }
 1316:     vf.submit();
 1317:   }
 1318:   function flip(vf,tf) {
 1319:   }
 1320: ENDPICK
 1321: }
 1322: 
 1323: sub csvupload_javascript_forward_associate {
 1324:     my $error1=&mt('You need to specify the name, starttime, endtime and a type');
 1325:   return(<<ENDPICK);
 1326:   function verify(vf) {
 1327:     var foundstart=0;
 1328:     var foundend=0;
 1329:     var foundname=0;
 1330:     var foundtype=0;
 1331:     for (i=0;i<=vf.nfields.value;i++) {
 1332:       tw=eval('vf.f'+i+'.selectedIndex');
 1333:       if (tw==1) { foundname=1; }
 1334:       if (tw==2) { foundtype=1; }
 1335:       if (tw==3) { foundstat=1; }
 1336:       if (tw==4) { foundend=1; }
 1337:     }
 1338:     if (foundstart==0 && foundend==0 && foundtype==0 && foundname==0) {
 1339: 	alert('$error1');
 1340: 	return;
 1341:     }
 1342:     vf.submit();
 1343:   }
 1344:   function flip(vf,tf) {
 1345:   }
 1346: ENDPICK
 1347: }
 1348: 
 1349: sub csv_upload_map {
 1350:     my ($r)= @_;
 1351: 
 1352:     my $datatoken;
 1353:     if (!$env{'form.datatoken'}) {
 1354: 	$datatoken=&Apache::loncommon::upfile_store($r);
 1355:     } else {
 1356: 	$datatoken=$env{'form.datatoken'};
 1357: 	&Apache::loncommon::load_tmp_file($r);
 1358:     }
 1359:     my @records=&Apache::loncommon::upfile_record_sep();
 1360:     if ($env{'form.noFirstLine'}) { shift(@records); }
 1361:     &csvuploadmap_header($r,$datatoken,$#records+1);
 1362:     my ($i,$keyfields);
 1363:     if (@records) {
 1364: 	my @fields=&csvupload_fields();
 1365: 
 1366: 	if ($env{'form.upfile_associate'} eq 'reverse') {	
 1367: 	    &Apache::loncommon::csv_print_samples($r,\@records);
 1368: 	    $i=&Apache::loncommon::csv_print_select_table($r,\@records,
 1369: 							  \@fields);
 1370: 	    foreach (@fields) { $keyfields.=$_->[0].','; }
 1371: 	    chop($keyfields);
 1372: 	} else {
 1373: 	    unshift(@fields,['none','']);
 1374: 	    $i=&Apache::loncommon::csv_samples_select_table($r,\@records,
 1375: 							    \@fields);
 1376: 	    my %sone=&Apache::loncommon::record_sep($records[0]);
 1377: 	    $keyfields=join(',',sort(keys(%sone)));
 1378: 	}
 1379:     }
 1380:     &csvuploadmap_footer($r,$i,$keyfields);
 1381: 
 1382:     return '';
 1383: }
 1384: 
 1385: sub csvupload_fields {
 1386:     return (['name','Slot name'],
 1387: 	    ['type','Type of slot'],
 1388: 	    ['starttime','Start Time of slot'],
 1389: 	    ['endtime','End Time of slot'],
 1390: 	    ['startreserve','Reservation Start Time'],
 1391: 	    ['ip','IP or DNS restriction'],
 1392: 	    ['proctor','List of proctor ids'],
 1393: 	    ['description','Slot Description'],
 1394: 	    ['maxspace','Maximum number of reservations'],
 1395: 	    ['symb','Resource Restriction'],
 1396: 	    ['uniqueperiod','Date range of slot exclusion'],
 1397: 	    ['secret','Secret word proctor uses to validate'],
 1398: 	    ['allowedsections','Sections slot is restricted to'],
 1399: 	    ['allowedusers','Users slot is restricted to'],
 1400: 	    );
 1401: }
 1402: 
 1403: sub csv_upload_assign {
 1404:     my ($r,$mgr)= @_;
 1405:     &Apache::loncommon::load_tmp_file($r);
 1406:     my @slotdata = &Apache::loncommon::upfile_record_sep();
 1407:     if ($env{'form.noFirstLine'}) { shift(@slotdata); }
 1408:     my %fields=&Apache::grades::get_fields();
 1409:     $r->print('<h3>Creating Slots</h3>');
 1410:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
 1411:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
 1412:     my $countdone=0;
 1413:     my @errors;
 1414:     foreach my $slot (@slotdata) {
 1415: 	my %slot;
 1416: 	my %entries=&Apache::loncommon::record_sep($slot);
 1417: 	my $domain;
 1418: 	my $name=$entries{$fields{'name'}};
 1419: 	if ($name=~/^\s*$/) {
 1420: 	    push(@errors,"Did not create slot with no name");
 1421: 	    next;
 1422: 	}
 1423: 	if ($name=~/\s/) { 
 1424: 	    push(@errors,"$name not created -- Name must not contain spaces");
 1425: 	    next;
 1426: 	}
 1427: 	if ($name=~/\W/) { 
 1428: 	    push(@errors,"$name not created -- Name must contain only letters, numbers and _");
 1429: 	    next;
 1430: 	}
 1431: 	if ($entries{$fields{'type'}}) {
 1432: 	    $slot{'type'}=$entries{$fields{'type'}};
 1433: 	} else {
 1434: 	    $slot{'type'}='preassigned';
 1435: 	}
 1436: 	if ($slot{'type'} ne 'preassigned' &&
 1437: 	    $slot{'type'} ne 'schedulable_student') {
 1438: 	    push(@errors,"$name not created -- invalid type ($slot{'type'}) must be either preassigned or schedulable_student");
 1439: 	    next;
 1440: 	}
 1441: 	if ($entries{$fields{'starttime'}}) {
 1442: 	    $slot{'starttime'}=&UnixDate($entries{$fields{'starttime'}},"%s");
 1443: 	}
 1444: 	if ($entries{$fields{'endtime'}}) {
 1445: 	    $slot{'endtime'}=&UnixDate($entries{$fields{'endtime'}},"%s");
 1446: 	}
 1447: 
 1448: 	# start/endtime must be defined and greater than zero
 1449: 	if (!$slot{'starttime'}) {
 1450: 	    push(@errors,"$name not created -- Invalid start time");
 1451: 	    next;
 1452: 	}
 1453: 	if (!$slot{'endtime'}) {
 1454: 	    push(@errors,"$name not created -- Invalid end time");
 1455: 	    next;
 1456: 	}
 1457: 	if ($slot{'starttime'} > $slot{'endtime'}) {
 1458: 	    push(@errors,"$name not created -- Slot starts after it ends");
 1459: 	    next;
 1460: 	}
 1461: 
 1462: 	if ($entries{$fields{'startreserve'}}) {
 1463: 	    $slot{'startreserve'}=
 1464: 		&UnixDate($entries{$fields{'startreserve'}},"%s");
 1465: 	}
 1466: 	if (defined($slot{'startreserve'})
 1467: 	    && $slot{'startreserve'} > $slot{'starttime'}) {
 1468: 	    push(@errors,"$name not created -- Slot's reservation start time is after the slot's start time.");
 1469: 	    next;
 1470: 	}
 1471: 
 1472: 	foreach my $key ('ip','proctor','description','maxspace',
 1473: 			 'secret','symb') {
 1474: 	    if ($entries{$fields{$key}}) {
 1475: 		$slot{$key}=$entries{$fields{$key}};
 1476: 	    }
 1477: 	}
 1478: 
 1479: 	if ($entries{$fields{'uniqueperiod'}}) {
 1480: 	    my ($start,$end)=split(',',$entries{$fields{'uniqueperiod'}});
 1481: 	    my @times=(&UnixDate($start,"%s"),
 1482: 		       &UnixDate($end,"%s"));
 1483: 	    $slot{'uniqueperiod'}=\@times;
 1484: 	}
 1485: 	if (defined($slot{'uniqueperiod'})
 1486: 	    && $slot{'uniqueperiod'}[0] > $slot{'uniqueperiod'}[1]) {
 1487: 	    push(@errors,"$name not created -- Slot's unique period start time is later than the unique period's end time.");
 1488: 	    next;
 1489: 	}
 1490: 
 1491: 	&Apache::lonnet::cput('slots',{$name=>\%slot},$cdom,$cname);
 1492: 	$r->print('.');
 1493: 	$r->rflush();
 1494: 	$countdone++;
 1495:     }
 1496:     $r->print("<p>Created $countdone slots\n</p>");
 1497:     foreach my $error (@errors) {
 1498: 	$r->print("<p>$error\n</p>");
 1499:     }
 1500:     &show_table($r,$mgr);
 1501:     return '';
 1502: }
 1503: 
 1504: sub handler {
 1505:     my $r=shift;
 1506: 
 1507:     &Apache::loncommon::content_type($r,'text/html');
 1508:     &Apache::loncommon::no_cache($r);
 1509:     if ($r->header_only()) {
 1510: 	$r->send_http_header();
 1511: 	return OK;
 1512:     }
 1513: 
 1514:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
 1515:     
 1516:     my $vgr=&Apache::lonnet::allowed('vgr',$env{'request.course.id'});
 1517:     my $mgr=&Apache::lonnet::allowed('mgr',$env{'request.course.id'});
 1518:     my $title='Requesting Another Worktime';
 1519:     if ($env{'form.command'} =~ /^(showslots|uploadstart|csvuploadmap|csvuploadassign)$/ && $vgr eq 'F') {
 1520: 	$title = 'Managing Slots';
 1521:     }
 1522:     &start_page($r,$title);
 1523: 
 1524:     if ($env{'form.command'} eq 'showslots' && $vgr eq 'F') {
 1525: 	&show_table($r,$mgr);
 1526:     } elsif ($env{'form.command'} eq 'remove_registration' && $mgr eq 'F') {
 1527: 	&remove_registration($r);
 1528:     } elsif ($env{'form.command'} eq 'release' && $mgr eq 'F') {
 1529: 	if ($env{'form.entry'} eq 'remove all') {
 1530: 	    &release_all_slot($r,$mgr);
 1531: 	} else {
 1532: 	    &release_slot($r,undef,undef,undef,$mgr);
 1533: 	}
 1534:     } elsif ($env{'form.command'} eq 'delete' && $mgr eq 'F') {
 1535: 	&delete_slot($r);
 1536:     } elsif ($env{'form.command'} eq 'uploadstart' && $mgr eq 'F') {
 1537: 	&upload_start($r);
 1538:     } elsif ($env{'form.command'} eq 'csvuploadmap' && $mgr eq 'F') {
 1539: 	&csv_upload_map($r);
 1540:     } elsif ($env{'form.command'} eq 'csvuploadassign' && $mgr eq 'F') {
 1541: 	if ($env{'form.associate'} ne 'Reverse Association') {
 1542: 	    &csv_upload_assign($r,$mgr);
 1543: 	} else {
 1544: 	    if ( $env{'form.upfile_associate'} ne 'reverse' ) {
 1545: 		$env{'form.upfile_associate'} = 'reverse';
 1546: 	    } else {
 1547: 		$env{'form.upfile_associate'} = 'forward';
 1548: 	    }
 1549: 	    &csv_upload_map($r);
 1550: 	}
 1551:     } else {
 1552: 	my $symb=&Apache::lonnet::unescape($env{'form.symb'});
 1553: 	my (undef,undef,$res)=&Apache::lonnet::decode_symb($symb);
 1554: 	my $useslots = &Apache::lonnet::EXT("resource.0.useslots",$symb);
 1555: 	if ($useslots ne 'resource' && $useslots ne 'map') {
 1556: 	    &fail($r,'not_valid');
 1557: 	    return OK;
 1558: 	}
 1559: 	$env{'request.symb'}=$symb;
 1560: 	my $type = ($res =~ /\.task$/) ? 'Task'
 1561: 	                               : 'problem';
 1562: 	my ($status) = &Apache::lonhomework::check_slot_access('0',$type);
 1563: 	if ($status eq 'CAN_ANSWER' ||
 1564: 	    $status eq 'NEEDS_CHECKIN' ||
 1565: 	    $status eq 'WAITING_FOR_GRADE') {
 1566: 	    &fail($r,'not_allowed');
 1567: 	    return OK;
 1568: 	}
 1569: 	if ($env{'form.requestattempt'}) {
 1570: 	    &show_choices($r,$symb);
 1571: 	} elsif ($env{'form.command'} eq 'release') {
 1572: 	    &release_slot($r,$symb);
 1573: 	} elsif ($env{'form.command'} eq 'get') {
 1574: 	    &get_slot($r,$symb);
 1575: 	} elsif ($env{'form.command'} eq 'change') {
 1576: 	    if (&release_slot($r,$symb,$env{'form.releaseslot'},1)) {
 1577: 		&get_slot($r,$symb);
 1578: 	    }
 1579: 	} else {
 1580: 	    $r->print("<p>Unknown command: ".$env{'form.command'}."</p>");
 1581: 	}
 1582:     }
 1583:     &end_page($r);
 1584:     return OK;
 1585: }
 1586: 
 1587: 1;
 1588: __END__

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