Annotation of loncom/interface/slotrequest.pm, revision 1.6

1.1       albertel    1: # The LearningOnline Network with CAPA
                      2: # Handler for requesting to have slots added to a students record
                      3: #
1.6     ! albertel    4: # $Id: slotrequest.pm,v 1.5 2005/08/09 07:34:51 albertel Exp $
1.1       albertel    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: 
                     38: sub fail {
                     39:     my ($r,$code)=@_;
1.2       albertel   40:     if ($code eq 'not_valid') {
                     41: 	$r->print('<p>'.&mt('Unable to understand what resource you wanted to sign up for.').'</p>'.$env{'form.symb'});
                     42: 
                     43:     }
                     44:     $r->print('<p><a href="/adm/flip?postdata=return:">'.
                     45: 	      &mt('Return to last resource').'</a></p>');
1.1       albertel   46:     &end_page($r);
                     47: }
                     48: 
                     49: sub start_page {
                     50:     my ($r)=@_;
                     51:     my $html=&Apache::lonxml::xmlbegin();
                     52:     $r->print($html.'<head><title>'.
                     53: 	      &mt('Request another Worktime').'</title></head>');
                     54:     $r->print(&Apache::loncommon::bodytag('Requesting another Worktime'));
                     55: }
                     56: 
                     57: sub end_page {
                     58:     my ($r)=@_;
                     59:     $r->print(&Apache::loncommon::endbodytag().'</html>');
                     60: }
                     61: 
1.2       albertel   62: =pod
                     63: 
                     64:  slot_reservations db
                     65:    - keys are 
                     66:     - slotname\0id -> value is an hashref of
                     67:                          name -> user@domain of holder
                     68:                          timestamp -> timestamp of reservation
                     69:                          symb -> symb of resource that it is reserved for
                     70: 
                     71: =cut
                     72: 
                     73: sub get_course {
                     74:     (undef,my $courseid)=&Apache::lonxml::whichuser();
                     75:     my $cdom=$env{'course.'.$courseid.'.domain'};
                     76:     my $cnum=$env{'course.'.$courseid.'.num'};
                     77:     return ($cnum,$cdom);
                     78: }
                     79: 
                     80: sub get_reservation_ids {
                     81:     my ($slot_name)=@_;
                     82:     
                     83:     my ($cnum,$cdom)=&get_course();
                     84: 
                     85:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                     86: 				       "^$slot_name\0");
                     87:     
                     88:     my ($tmp)=%consumed;
                     89:     if ($tmp=~/^error: 2 / ) {
                     90: 	return 0;
                     91:     }
                     92:     return keys(%consumed);
                     93: }
                     94: 
                     95: sub space_available {
                     96:     my ($slot_name,$slot)=@_;
                     97:     my $max=$slot->{'maxspace'};
                     98: 
                     99:     if (!defined($max)) { return 1; }
                    100: 
                    101:     my $consumed=scalar(&get_reservation_ids($slot_name));
                    102:     if ($consumed < $max) {
                    103: 	return 1
                    104:     }
                    105:     return 0;
                    106: }
1.3       albertel  107: 
1.4       albertel  108: sub check_for_reservation {
                    109:     my ($symb)=@_;
                    110:     my $student = &Apache::lonnet::EXT("resource.0.availablestudent", $symb,
                    111: 				       $env{'user.domain'}, $env{'user.name'});
                    112: 
                    113:     my $course = &Apache::lonnet::EXT("resource.0.available", $symb,
                    114: 				    $env{'user.domain'}, $env{'user.name'});
                    115:     my @slots = (split(/:/,$student), split(/:/, $course));
                    116: 
                    117:     &Apache::lonxml::debug(" slot list is ".join(':',@slots));
                    118: 
                    119:     my ($cnum,$cdom)=&get_course();
                    120:     my %slots=&Apache::lonnet::get('slots', [@slots], $cdom, $cnum);
                    121: 
                    122:     foreach my $slot_name (@slots) {
                    123: 	next if (!defined($slots{$slot_name}) ||
                    124: 		 !ref($slots{$slot_name}));
                    125: 	&Apache::lonxml::debug(time." $slot_name ".
                    126: 			       $slots{$slot_name}->{'starttime'}." -- ".
                    127: 			       $slots{$slot_name}->{'startreserve'});
                    128: 	if ($slots{$slot_name}->{'starttime'} > time &&
                    129: 	    $slots{$slot_name}->{'startreserve'} < time) {
                    130: 	    # between start of reservation times and start of slot
                    131: 	    return($slot_name, $slots{$slot_name});
                    132: 	}
                    133:     }
                    134:     return (undef,undef);
                    135: }
                    136: 
1.5       albertel  137: sub check_for_conflict {
                    138:     my ($symb,$new_slot_name)=@_;
                    139:     my $student = &Apache::lonnet::EXT("resource.0.availablestudent", $symb,
                    140: 				       $env{'user.domain'}, $env{'user.name'});
                    141:     my $course = &Apache::lonnet::EXT("resource.0.available", $symb,
                    142: 				      $env{'user.domain'}, $env{'user.name'});
                    143:     my @slots = (split(/:/,$student), split(/:/, $course));
                    144:     my ($cnum,$cdom)=&get_course();
                    145:     my %slots=&Apache::lonnet::get('slots', [@slots], $cdom, $cnum);
                    146:     foreach my $slot_name (@slots) {
                    147: 	next if (!defined($slots{$slot_name}) ||
                    148: 		 !ref($slots{$slot_name}));
                    149: 
                    150:         next if (!defined($slots{$slot_name}->{'uniqueperiod'}) ||
                    151: 		 !ref($slots{$slot_name}->{'uniqueperiod'}));
                    152: 	my ($start,$end)=@{$slots{$slot_name}->{'uniqueperiod'}};
                    153: 	if ($start<time && time < $end) {
                    154: 	    return $slot_name;
                    155: 	}
                    156:     }
                    157:     return undef;
                    158: 
                    159: }
                    160: 
1.3       albertel  161: # FIXME - depends on the parameter for the resource to be correct
1.5       albertel  162: #         to prevent multiple reservations
1.3       albertel  163: 
1.2       albertel  164: sub make_reservation {
                    165:     my ($slot_name,$slot,$symb)=@_;
1.3       albertel  166: 
                    167:     my ($cnum,$cdom)=&get_course();
                    168: 
                    169:     my $value=&Apache::lonnet::EXT("resource.0.availablestudent",$symb,
                    170: 				   $env{'user.domain'},$env{'user.name'});
                    171:     &Apache::lonxml::debug("value is  $value<br />");
                    172:     foreach my $other_slot (split(/:/, $value)) {
                    173: 	if ($other_slot eq $slot_name) {
                    174: 	    my %consumed=&Apache::lonnet::dump('slot_reservations', $cdom,
                    175: 					       $cnum, "^$slot_name\0");   
                    176: 
                    177: 	    my $me=$env{'user.name'}.'@'.$env{'user.domain'};
                    178: 	    foreach my $key (keys(%consumed)) {
                    179: 		if ($consumed{$key}->{'name'} eq $me) {
                    180: 		    my $num=(split('\0',$key))[1];
                    181: 		    return -$num;
                    182: 		}
                    183: 	    }
                    184: 	}
                    185:     }
                    186: 
1.2       albertel  187:     my $max=$slot->{'maxspace'};
1.3       albertel  188:     if (!defined($max)) { $max=99999; }
1.2       albertel  189: 
                    190:     my (@ids)=&get_reservation_ids($slot_name);
                    191: 
                    192:     # FIXME we could end up having holes... 
                    193:     my $last=0;
                    194:     foreach my $id (@ids) {
                    195: 	my $num=(split('\0',$id))[1];
                    196: 	if ($num > $last) { $last=$num; }
                    197:     }
                    198:     
                    199:     my $wanted=$last+1;
1.3       albertel  200:     &Apache::lonxml::debug("wanted $wanted<br />");
1.2       albertel  201:     if ($wanted >= $max) {
                    202: 	# full up
                    203: 	return -1;
                    204:     }
                    205:     
                    206:     my %reservation=('name'      => $env{'user.name'}.'@'.$env{'user.domain'},
                    207: 		     'timestamp' => time,
                    208: 		     'symb'      => $symb);
                    209: 
                    210:     my $success=&Apache::lonnet::newput('slot_reservations',
                    211: 					{"$slot_name\0$wanted" =>
                    212: 					     \%reservation},
1.3       albertel  213: 					$cdom, $cnum);
                    214: 
1.2       albertel  215:     if ($success eq 'ok') {
1.3       albertel  216: 	#FIXME need to set the parm
                    217: 	my $new_value=$slot_name;
                    218: 	if ($value) {
                    219: 	    $new_value=$value.':'.$new_value;
                    220: 	}
                    221: 	my $result=&Apache::lonparmset::storeparm_by_symb($symb,
                    222: 						      '0_availablestudent',
                    223: 						       1, $new_value, 'string',
                    224: 						       $env{'user.name'},
                    225: 					               $env{'user.domain'});
                    226: 	&Apache::lonxml::debug("hrrm $result");
1.2       albertel  227: 	return $wanted;
                    228:     }
1.3       albertel  229: 
1.2       albertel  230:     # someone else got it
1.3       albertel  231:     return undef;
                    232: }
                    233: 
1.5       albertel  234: sub release_slot {
1.6     ! albertel  235:     my ($r,$symb,$slot_name,$inhibit_return_link)=@_;
        !           236: 
        !           237:     if ($slot_name eq '') { $slot_name=$env{'form.slotname'}; }
        !           238:     my ($cnum,$cdom)=&get_course();
        !           239: 
1.5       albertel  240:     # get parameter string, check for existance, rebuild string with the slot
1.6     ! albertel  241: 				       
        !           242:     my @slots = split(/:/,&Apache::lonnet::EXT("resource.0.availablestudent",
        !           243: 					       $symb,$env{'user.domain'},
        !           244: 					       $env{'user.name'}));
        !           245:     my @new_slots;
        !           246:     foreach my $exist_slot (@slots) {
        !           247: 	if ($exist_slot eq $slot_name) { next; }
        !           248: 	push(@new_slots,$exist_slot);
        !           249:     }
        !           250:     my $new_param = join(':',@new_slots);
1.5       albertel  251: 
                    252:     # get slot reservations, check if user has one, if so remove reservation
1.6     ! albertel  253:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
        !           254: 				       "^$slot_name\0");
        !           255:     foreach my $entry (keys(%consumed)) {
        !           256: 	if ( $consumed{$entry}->{'name'} eq 
        !           257: 	     ($env{'user.name'}.'@'.$env{'user.domain'}) ) {
        !           258: 	    &Apache::lonnet::del('slot_reservations',[$entry],
        !           259: 				 $cdom,$cnum);
        !           260: 	}
        !           261:     }
1.5       albertel  262:     # store new parameter string
1.6     ! albertel  263:     my $result=&Apache::lonparmset::storeparm_by_symb($symb,
        !           264: 						      '0_availablestudent',
        !           265: 						      1, $new_param, 'string',
        !           266: 						      $env{'user.name'},
        !           267: 						      $env{'user.domain'});
        !           268:     my %slot=&Apache::lonnet::get_slot($slot_name);
        !           269:     my $description=&get_description($env{'form.slotname'},\%slot);
        !           270:     $r->print("<p>Released Reservation: $description</p>");
        !           271:     if ($inhibit_return_link) {
        !           272: 	$r->print('<p><a href="/adm/flip?postdata=return:">'.
        !           273: 		  &mt('Return to last resource').'</a></p>');
        !           274:     }
        !           275:     return 1;
1.5       albertel  276: }
                    277: 
1.3       albertel  278: sub get_slot {
                    279:     my ($r,$symb)=@_;
                    280: 
1.5       albertel  281:     my $slot_name=&check_for_conflict($symb,$env{'form.slotname'});
                    282:     if ($slot_name) {
                    283: 	my %slot=&Apache::lonnet::get_slot($slot_name);
1.6     ! albertel  284: 	my $description1=&get_description($slot_name,\%slot);
        !           285: 	%slot=&Apache::lonnet::get_slot($env{'form.slotname'});
        !           286: 	my $description2=&get_description($env{'form.slotname'},\%slot);
        !           287: 	$r->print("<p>Already have a reservation: $description1</p>");
        !           288: 	$r->print(<<STUFF);
        !           289: <form method="POST" action="/adm/slotrequest">
        !           290:    <input type="hidden" name="symb" value="$env{'form.symb'}" />
        !           291:    <input type="hidden" name="slotname" value="$env{'form.slotname'}" />
        !           292:    <input type="hidden" name="releaseslot" value="$slot_name" />
        !           293:    <input type="hidden" name="command" value="change" />
        !           294: STUFF
        !           295: 	$r->print("<p>You can either ");
        !           296: 	$r->print(<<STUFF);
        !           297:    <input type="submit" name="change" value="Change" />
        !           298: STUFF
        !           299: 	$r->print(' your reservation from <b>'.$description1.'</b> to <b>'.
        !           300: 		  $description2.
        !           301: 		  '</b> <br />or <a href="/adm/flip?postdata=return:">'.
1.5       albertel  302: 		  &mt('Return to last resource').'</a></p>');
1.6     ! albertel  303: 	$r->print(<<STUFF);
        !           304: </form>
        !           305: STUFF
        !           306: 	# FIXME add button to free current reservation and get new one
1.5       albertel  307: 	return;
                    308:     }
1.3       albertel  309:     my %slot=&Apache::lonnet::get_slot($env{'form.slotname'});
                    310:     my $reserved=&make_reservation($env{'form.slotname'},
                    311: 				   \%slot,$symb);
                    312:     my $description=&get_description($env{'form.slotname'},\%slot);
                    313:     if ($reserved > -1) {
                    314: 	$r->print("<p>Success: $description</p>");
                    315: 	$r->print('<p><a href="/adm/flip?postdata=return:">'.
                    316: 		  &mt('Return to last resource').'</a></p>');
                    317: 	return;
                    318:     } elsif ($reserved < 0) {
                    319: 	$r->print("<p>Already reserved: $description</p>");
                    320: 	$r->print('<p><a href="/adm/flip?postdata=return:">'.
                    321: 		  &mt('Return to last resource').'</a></p>');
                    322: 	return;
                    323:     }
                    324: 
                    325:     my %lt=('request'=>"Request another attempt",
                    326: 	    'try'    =>'Try again');
                    327:     %lt=&Apache::lonlocal::texthash(%lt);
                    328: 
                    329:     $r->print(<<STUFF);
                    330: <p> <font color="red">Failed</font> to reserve a spot for $description. </p>
                    331: <p>
                    332: <form method="POST" action="/adm/slotrequest">
                    333:    <input type="submit" name="Try Again" value="$lt{'try'}" />
                    334:    <input type="hidden" name="symb" value="$env{'form.symb'}" />
                    335:    <input type="hidden" name="slotname" value="$env{'form.slotname'}" />
                    336:    <input type="hidden" name="command" value="get" />
                    337: </form>
                    338: ?
                    339: </p>
                    340: <p>
                    341: or
                    342: <form method="POST" action="/adm/slotrequest">
                    343:     <input type="hidden" name="symb" value="$env{'form.symb'}" />
                    344:     <input type="submit" name="requestattempt" value="$lt{'request'}" />
                    345: </form>
                    346: </p>
                    347: or
                    348: STUFF
                    349:     $r->print('<p><a href="/adm/flip?postdata=return:">'.
                    350: 	      &mt('Return to last resource').'</a></p>');
                    351:     return;
                    352: }
                    353: 
                    354: sub allowed_slot {
                    355:     my ($slot_name,$slot,$symb)=@_;
                    356:     #already started
                    357:     if ($slot->{'starttime'} < time) {
1.5       albertel  358: 	# all open slot to be schedulable
                    359: 	#return 0;
1.3       albertel  360:     }
1.5       albertel  361:     &Apache::lonxml::debug("$slot_name starttime good");
1.3       albertel  362:     #already ended
                    363:     if ($slot->{'endtime'} < time) {
                    364: 	return 0;
                    365:     }
1.5       albertel  366:     &Apache::lonxml::debug("$slot_name endtime good");
1.3       albertel  367:     # not allowed to pick this one
                    368:     if (defined($slot->{'type'})
                    369: 	&& $slot->{'type'} ne 'schedulable_student') {
                    370: 	return 0;
                    371:     }
1.5       albertel  372:     &Apache::lonxml::debug("$slot_name type good");
1.3       albertel  373:     # not allowed for this resource
                    374:     if (defined($slot->{'symb'})
                    375: 	&& $slot->{'symb'} ne $symb) {
                    376: 	return 0;
                    377:     }
1.5       albertel  378:     &Apache::lonxml::debug("$slot_name symb good");
1.3       albertel  379:     return 1;
1.2       albertel  380: }
                    381: 
1.3       albertel  382: sub get_description {
                    383:     my ($slot_name,$slot)=@_;
                    384:     my $description=$slot->{'description'};
                    385:     if (!defined($description)) {
1.4       albertel  386: 	$description=&mt('[_1] From [_2] to [_3]',$slot_name,
1.3       albertel  387: 			 &Apache::lonlocal::locallocaltime($slot->{'starttime'}),
                    388: 			 &Apache::lonlocal::locallocaltime($slot->{'endtime'}));
                    389:     }
                    390:     return $description;
                    391: }
1.2       albertel  392: 
                    393: sub show_choices {
                    394:     my ($r,$symb)=@_;
                    395: 
                    396:     my ($cnum,$cdom)=&get_course();
                    397:     my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);
1.3       albertel  398:     my $available;
1.2       albertel  399:     $r->print('<table border="1">');
1.5       albertel  400:     &Apache::lonxml::debug("Checking Slots");
                    401:     my ($got_slot)=&check_for_reservation($symb);
1.2       albertel  402:     foreach my $slot (sort 
                    403: 		      { return $slots{$a}->{'starttime'} <=> $slots{$b}->{'starttime'} }
                    404: 		      (keys(%slots)))  {
1.5       albertel  405: 
                    406: 	&Apache::lonxml::debug("Checking Slot $slot");
1.3       albertel  407: 	next if (!&allowed_slot($slot,$slots{$slot}));
                    408: 
                    409: 	$available++;
                    410: 
                    411: 	my $description=&get_description($slot,$slots{$slot});
1.2       albertel  412: 
                    413: 	my $form=&mt('Unavailable');
1.3       albertel  414: 	if (&space_available($slot,$slots{$slot},$symb)) {
1.5       albertel  415: 	    my $text=&mt('Select');
                    416: 	    my $command='get';
                    417: 	    if ($slot eq $got_slot) {
                    418: 		$text=&mt('Free Reservation');
                    419: 		$command='release';
                    420: 	    }
1.3       albertel  421: 	    my $escsymb=&Apache::lonnet::escape($symb);
1.2       albertel  422: 	    $form=<<STUFF;
1.3       albertel  423:    <form method="POST" action="/adm/slotrequest">
1.5       albertel  424:      <input type="submit" name="Select" value="$text" />
1.3       albertel  425:      <input type="hidden" name="symb" value="$escsymb" />
                    426:      <input type="hidden" name="slotname" value="$slot" />
1.5       albertel  427:      <input type="hidden" name="command" value="$command" />
1.2       albertel  428:    </form>
                    429: STUFF
                    430: 	}
                    431: 	$r->print(<<STUFF);
                    432: <tr>
                    433:  <td>$form</td>
                    434:  <td>$description</td>
                    435: </tr>
                    436: STUFF
                    437:     }
1.3       albertel  438: 
                    439:     if (!$available) {
1.5       albertel  440: 	$r->print('<tr><td>No available times. <a href="/adm/flip?postdata=return:">'.
1.3       albertel  441: 		  &mt('Return to last resource').'</a></td></tr>');
                    442:     }
1.2       albertel  443:     $r->print('</table>');
                    444: }
                    445: 
1.5       albertel  446: sub show_table {
                    447:     my ($r,$symb)=@_;
                    448: 
                    449:     my ($cnum,$cdom)=&get_course();
                    450:     my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);
                    451:     my $available;
                    452:     $r->print('<table border="1">');
                    453:     foreach my $slot (sort 
                    454: 		      { return $slots{$a}->{'starttime'} <=> $slots{$b}->{'starttime'} }
                    455: 		      (keys(%slots)))  {
                    456: 	if (defined($slots{$slot}->{'type'})
                    457: 	    && $slots{$slot}->{'type'} ne 'schedulable_student') {
                    458: 	    next;
                    459: 	}
                    460: 	my $description=&get_description($slot,$slots{$slot});
                    461: 	my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                    462: 					   "^$slot\0");
                    463: 	my $ids;
                    464: 	foreach my $entry (sort(keys(%consumed))) {
                    465: 	    my (undef,$id)=split("\0",$entry);
                    466: 	    $ids.= $id.'-> '.$consumed{$entry}->{'name'}.'<br />';
                    467: 	}
                    468: 	my $start=localtime($slots{$slot}->{'starttime'});
                    469: 	my $end=localtime($slots{$slot}->{'endtime'});
                    470: 	$r->print(<<STUFF);
                    471: <tr>
                    472:  <td>$slot</td>
                    473:  <td>$description</td>
                    474:  <td>$start</td>
                    475:  <td>$end</td>
                    476:  <td>$slots{$slot}->{'maxspace'}</td>
                    477:  <td>$ids</td>
                    478: </tr>
                    479: STUFF
                    480:     }
                    481:     $r->print('</table>');
                    482: }
                    483: 
1.1       albertel  484: sub handler {
                    485:     my $r=shift;
                    486: 
                    487:     &start_page($r);
1.2       albertel  488:     my $symb=&Apache::lonnet::unescape($env{'form.symb'});
1.1       albertel  489:     my (undef,undef,$res)=&Apache::lonnet::decode_symb($symb);
1.2       albertel  490:     if ($res !~ /\.task$/) {
1.1       albertel  491: 	&fail($r,'not_valid');
                    492: 	return OK;
                    493:     }
1.5       albertel  494:  
                    495:     if ($env{'form.command'} eq 'showslots') {
                    496: 	&show_table($r,$symb);
                    497:     } elsif ($env{'form.requestattempt'}) {
1.2       albertel  498: 	&show_choices($r,$symb);
1.5       albertel  499:     } elsif ($env{'form.command'} eq 'release') {
                    500: 	&release_slot($r,$symb);
1.3       albertel  501:     } elsif ($env{'form.command'} eq 'get') {
                    502: 	&get_slot($r,$symb);
1.6     ! albertel  503:     } elsif ($env{'form.command'} eq 'change') {
        !           504:        	&release_slot($r,$symb,$env{'form.releaseslot'},1);
        !           505: 	&get_slot($r,$symb);
1.2       albertel  506:     }
1.1       albertel  507:     &end_page($r);
                    508:     return OK;
                    509: }
1.3       albertel  510: 
                    511: 1;
                    512: __END__

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