# The LearningOnline Network with CAPA
# Handler for requesting to have slots added to a students record
#
# $Id: slotrequest.pm,v 1.110 2011/01/03 18:04:56 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
package Apache::slotrequest;
use strict;
use Apache::Constants qw(:common :http :methods);
use Apache::loncommon();
use Apache::lonlocal;
use Apache::lonnet;
use Apache::lonnavmaps();
use Date::Manip;
use lib '/home/httpd/lib/perl/';
use LONCAPA;
sub fail {
my ($r,$code)=@_;
if ($code eq 'not_valid') {
$r->print('
'.&mt('Unable to understand what resource you wanted to sign up for.').'
'.&mt('Not allowed to sign up or change reservations at this time.').'
');
} else {
$r->print('
'.&mt('Failed.').'
');
}
&return_link($r);
&end_page($r);
}
sub start_page {
my ($r,$title,$brcrum)=@_;
my $args;
if (ref($brcrum) eq 'ARRAY') {
$args = {bread_crumbs => $brcrum};
}
$r->print(&Apache::loncommon::start_page($title,undef,$args));
}
sub end_page {
my ($r)=@_;
$r->print(&Apache::loncommon::end_page());
}
=pod
slot_reservations db
- keys are
- slotname\0id -> value is an hashref of
name -> user@domain of holder
timestamp -> timestamp of reservation
symb -> symb of resource that it is reserved for
=cut
sub get_course {
(undef,my $courseid)=&Apache::lonnet::whichuser();
my $cdom=$env{'course.'.$courseid.'.domain'};
my $cnum=$env{'course.'.$courseid.'.num'};
return ($cnum,$cdom);
}
sub get_reservation_ids {
my ($slot_name)=@_;
my ($cnum,$cdom)=&get_course();
my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
"^$slot_name\0");
if (&Apache::lonnet::error(%consumed)) {
return 'error: Unable to determine current status';
}
my ($tmp)=%consumed;
if ($tmp=~/^error: 2 / ) {
return 0;
}
return keys(%consumed);
}
sub space_available {
my ($slot_name,$slot)=@_;
my $max=$slot->{'maxspace'};
if (!defined($max)) { return 1; }
my $consumed=scalar(&get_reservation_ids($slot_name));
if ($consumed < $max) {
return 1
}
return 0;
}
sub check_for_reservation {
my ($symb,$mode)=@_;
my $student = &Apache::lonnet::EXT("resource.0.availablestudent", $symb,
$env{'user.domain'}, $env{'user.name'});
my $course = &Apache::lonnet::EXT("resource.0.available", $symb,
$env{'user.domain'}, $env{'user.name'});
my @slots = (split(/:/,$student), split(/:/, $course));
&Apache::lonxml::debug(" slot list is ".join(':',@slots));
my ($cnum,$cdom)=&get_course();
my %slots=&Apache::lonnet::get('slots', [@slots], $cdom, $cnum);
if (&Apache::lonnet::error($student)
|| &Apache::lonnet::error($course)
|| &Apache::lonnet::error(%slots)) {
return 'error: Unable to determine current status';
}
my @got;
my @sorted_slots = &Apache::loncommon::sorted_slots(\@slots,\%slots);
foreach my $slot_name (@sorted_slots) {
next if (!defined($slots{$slot_name}) ||
!ref($slots{$slot_name}));
&Apache::lonxml::debug(time." $slot_name ".
$slots{$slot_name}->{'starttime'}." -- ".
$slots{$slot_name}->{'startreserve'});
if ($slots{$slot_name}->{'endtime'} > time &&
$slots{$slot_name}->{'startreserve'} < time) {
# between start of reservation times and end of slot
if ($mode eq 'allslots') {
push(@got,$slot_name);
} else {
return($slot_name, $slots{$slot_name});
}
}
}
if ($mode eq 'allslots' && @got) {
return @got;
}
return (undef,undef);
}
sub get_consumed_uniqueperiods {
my ($slots) = @_;
my $navmap=Apache::lonnavmaps::navmap->new;
if (!defined($navmap)) {
return 'error: Unable to determine current status';
}
my @problems = $navmap->retrieveResources(undef,
sub { $_[0]->is_problem() },1,0);
my %used_slots;
foreach my $problem (@problems) {
my $symb = $problem->symb();
my $student = &Apache::lonnet::EXT("resource.0.availablestudent",
$symb, $env{'user.domain'},
$env{'user.name'});
my $course = &Apache::lonnet::EXT("resource.0.available",
$symb, $env{'user.domain'},
$env{'user.name'});
if (&Apache::lonnet::error($student)
|| &Apache::lonnet::error($course)) {
return 'error: Unable to determine current status';
}
foreach my $slot (split(/:/,$student), split(/:/, $course)) {
$used_slots{$slot}=1;
}
}
if (!ref($slots)) {
my ($cnum,$cdom)=&get_course();
my %slots=&Apache::lonnet::get('slots', [keys(%used_slots)], $cdom, $cnum);
if (&Apache::lonnet::error(%slots)) {
return 'error: Unable to determine current status';
}
$slots = \%slots;
}
my %consumed_uniqueperiods;
foreach my $slot_name (keys(%used_slots)) {
next if (!defined($slots->{$slot_name}) ||
!ref($slots->{$slot_name}));
next if (!defined($slots->{$slot_name}{'uniqueperiod'}) ||
!ref($slots->{$slot_name}{'uniqueperiod'}));
$consumed_uniqueperiods{$slot_name} =
$slots->{$slot_name}{'uniqueperiod'};
}
return \%consumed_uniqueperiods;
}
sub check_for_conflict {
my ($symb,$new_slot_name,$new_slot,$slots,$consumed_uniqueperiods)=@_;
if (!defined($new_slot->{'uniqueperiod'})) { return undef; }
if (!ref($consumed_uniqueperiods)) {
$consumed_uniqueperiods = &get_consumed_uniqueperiods($slots);
if (ref($consumed_uniqueperiods) eq 'HASH') {
if (&Apache::lonnet::error(%$consumed_uniqueperiods)) {
return 'error: Unable to determine current status';
}
} else {
return 'error: Unable to determine current status';
}
}
my ($new_uniq_start,$new_uniq_end) = @{$new_slot->{'uniqueperiod'}};
foreach my $slot_name (keys(%$consumed_uniqueperiods)) {
my ($start,$end)=@{$consumed_uniqueperiods->{$slot_name}};
if (!
($start < $new_uniq_start && $end < $new_uniq_start) ||
($start > $new_uniq_end && $end > $new_uniq_end )) {
return $slot_name;
}
}
return undef;
}
sub make_reservation {
my ($slot_name,$slot,$symb,$cnum,$cdom)=@_;
my $value=&Apache::lonnet::EXT("resource.0.availablestudent",$symb,
$env{'user.domain'},$env{'user.name'});
&Apache::lonxml::debug("value is $value ");
my $use_slots = &Apache::lonnet::EXT("resource.0.useslots",$symb,
$env{'user.domain'},$env{'user.name'});
&Apache::lonxml::debug("use_slots is $use_slots ");
if (&Apache::lonnet::error($value)
|| &Apache::lonnet::error($use_slots)) {
return 'error: Unable to determine current status';
}
my $parm_symb = $symb;
my $parm_level = 1;
if ($use_slots eq 'map' || $use_slots eq 'map_map') {
my ($map) = &Apache::lonnet::decode_symb($symb);
$parm_symb = &Apache::lonnet::symbread($map);
$parm_level = 2;
}
foreach my $other_slot (split(/:/, $value)) {
if ($other_slot eq $slot_name) {
my %consumed=&Apache::lonnet::dump('slot_reservations', $cdom,
$cnum, "^$slot_name\0");
if (&Apache::lonnet::error($value)) {
return 'error: Unable to determine current status';
}
my $me=$env{'user.name'}.':'.$env{'user.domain'};
foreach my $key (keys(%consumed)) {
if ($consumed{$key}->{'name'} eq $me) {
my $num=(split('\0',$key))[1];
return -$num;
}
}
}
}
my $max=$slot->{'maxspace'};
if (!defined($max)) { $max=99999; }
my (@ids)=&get_reservation_ids($slot_name);
if (&Apache::lonnet::error(@ids)) {
return 'error: Unable to determine current status';
}
my $last=0;
foreach my $id (@ids) {
my $num=(split('\0',$id))[1];
if ($num > $last) { $last=$num; }
}
my $wanted=$last+1;
&Apache::lonxml::debug("wanted $wanted ");
if (scalar(@ids) >= $max) {
# full up
return undef;
}
my %reservation=('name' => $env{'user.name'}.':'.$env{'user.domain'},
'timestamp' => time,
'symb' => $parm_symb);
my $success=&Apache::lonnet::newput('slot_reservations',
{"$slot_name\0$wanted" =>
\%reservation},
$cdom, $cnum);
if ($success eq 'ok') {
my $new_value=$slot_name;
if ($value) {
$new_value=$value.':'.$new_value;
}
&store_slot_parm($symb,$slot_name,$parm_level,$new_value,$cnum,$cdom);
return $wanted;
}
# someone else got it
return undef;
}
sub store_slot_parm {
my ($symb,$slot_name,$parm_level,$new_value,$cnum,$cdom) = @_;
my $result=&Apache::lonparmset::storeparm_by_symb($symb,
'0_availablestudent',
$parm_level, $new_value,
'string',
$env{'user.name'},
$env{'user.domain'});
&Apache::lonxml::debug("hrrm $result");
my %storehash = (
symb => $symb,
slot => $slot_name,
action => 'reserve',
context => $env{'form.context'},
);
&Apache::lonnet::instructor_log('slotreservationslog',\%storehash,
'',$env{'user.name'},$env{'user.domain'},
$cnum,$cdom);
&Apache::lonnet::instructor_log($cdom.'_'.$cnum.'_slotlog',\%storehash,
1,$env{'user.name'},$env{'user.domain'},
$env{'user.name'},$env{'user.domain'});
return;
}
sub remove_registration {
my ($r) = @_;
if ($env{'form.entry'} ne 'remove all') {
return &remove_registration_user($r);
}
my $slot_name = $env{'form.slotname'};
my %slot=&Apache::lonnet::get_slot($slot_name);
my ($cnum,$cdom)=&get_course();
my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
"^$slot_name\0");
if (&Apache::lonnet::error(%consumed)) {
$r->print("
".&mt('A network error has occurred.').'
');
return;
}
if (!%consumed) {
$r->print('
'.&mt('Slot [_1] has no reservations.',
''.$slot_name.'').'
');
return;
}
my @names = map { $consumed{$_}{'name'} } (sort(keys(%consumed)));
my $names = join(' ',@names);
my $msg = &mt('Remove all of [_1] from slot [_2]?',$names,$slot_name);
&remove_registration_confirmation($r,$msg,['entry','slotname','context']);
}
sub remove_registration_user {
my ($r) = @_;
my $slot_name = $env{'form.slotname'};
my $name = &Apache::loncommon::plainname($env{'form.uname'},
$env{'form.udom'});
my $title = &Apache::lonnet::gettitle($env{'form.symb'});
my $msg = &mt('Remove [_1] from slot [_2] for [_3]',
$name,$slot_name,$title);
&remove_registration_confirmation($r,$msg,['uname','udom','slotname',
'entry','symb','context']);
}
sub remove_registration_confirmation {
my ($r,$msg,$inputs) =@_;
my $hidden_input;
foreach my $parm (@{$inputs}) {
$hidden_input .=
'&\'').'" />'."\n";
}
my %lt = &Apache::lonlocal::texthash(
'yes' => 'Yes',
'no' => 'No',
);
$r->print(<<"END_CONFIRM");
$msg
END_CONFIRM
}
sub release_all_slot {
my ($r,$mgr)=@_;
my $slot_name = $env{'form.slotname'};
my ($cnum,$cdom)=&get_course();
my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
"^$slot_name\0");
$r->print('
'.&mt('Releasing reservations').'
');
foreach my $entry (sort { $consumed{$a}{'name'} cmp
$consumed{$b}{'name'} } (keys(%consumed))) {
my ($uname,$udom) = split(':',$consumed{$entry}{'name'});
my ($result,$msg) =
&release_reservation($slot_name,$uname,$udom,
$consumed{$entry}{'symb'},$mgr);
if (!$result) {
$r->print('
');
}
if (!$inhibit_return_link) { &return_link($r); }
return $result;
}
sub release_reservation {
my ($slot_name,$uname,$udom,$symb,$mgr) = @_;
my %slot=&Apache::lonnet::get_slot($slot_name);
my $description=&get_description($slot_name,\%slot);
if ($mgr ne 'F') {
if ($slot{'starttime'} < time) {
return (0,&mt('Not allowed to release Reservation: [_1], as it has already ended.',$description));
}
}
# if the reservation symb is for a map get a resource in that map
# to check slot parameters on
my $navmap=Apache::lonnavmaps::navmap->new;
if (!defined($navmap)) {
return (0,'error: Unable to determine current status');
}
my $passed_resource = $navmap->getBySymb($symb);
if ($passed_resource->is_map()) {
my ($a_resource) =
$navmap->retrieveResources($passed_resource,
sub {$_[0]->is_problem()},0,1);
$symb = $a_resource->symb();
}
# get parameter string, check for existance, rebuild string with the slot
my $student = &Apache::lonnet::EXT("resource.0.availablestudent",
$symb,$udom,$uname);
my @slots = split(/:/,$student);
my @new_slots;
foreach my $exist_slot (@slots) {
if ($exist_slot eq $slot_name) { next; }
push(@new_slots,$exist_slot);
}
my $new_param = join(':',@new_slots);
my ($cnum,$cdom)=&get_course();
# get slot reservations, check if user has one, if so remove reservation
my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
"^$slot_name\0");
foreach my $entry (keys(%consumed)) {
if ( $consumed{$entry}->{'name'} eq ($uname.':'.$udom) ) {
&Apache::lonnet::del('slot_reservations',[$entry],
$cdom,$cnum);
my %storehash = (
symb => $symb,
slot => $slot_name,
action => 'release',
context => $env{'form.context'},
);
&Apache::lonnet::instructor_log('slotreservationslog',\%storehash,
1,$uname,$udom,$cnum,$cdom);
&Apache::lonnet::instructor_log($cdom.'_'.$cnum.'_slotlog',\%storehash,
1,$uname,$udom,$uname,$udom);
}
}
my $use_slots = &Apache::lonnet::EXT("resource.0.useslots",
$symb,$udom,$uname);
&Apache::lonxml::debug("use_slots is $use_slots ");
if (&Apache::lonnet::error($use_slots)) {
return (0,'error: Unable to determine current status');
}
my $parm_level = 1;
if ($use_slots eq 'map' || $use_slots eq 'map_map') {
$parm_level = 2;
}
# store new parameter string
my $result=&Apache::lonparmset::storeparm_by_symb($symb,
'0_availablestudent',
$parm_level, $new_param,
'string', $uname, $udom);
my $msg;
if ($mgr eq 'F') {
$msg = &mt('Released Reservation for user: [_1]',"$uname:$udom");
} else {
$msg = ''.&mt('Released reservation: [_1]',$description).'
';
my $person = &Apache::loncommon::plainname($env{'user.name'},$env{'user.domain'});
my $subject = &mt('Reservation change: [_1]',$description);
my $msgbody = &mt('Reservation released by [_1] for [_2].',$person,$description);
$msg .= &slot_change_messaging($slot{'reservationmsg'},$subject,$msgbody,'release');
}
return (1,$msg);
}
sub delete_slot {
my ($r)=@_;
my $slot_name = $env{'form.slotname'};
my %slot=&Apache::lonnet::get_slot($slot_name);
my ($cnum,$cdom)=&get_course();
my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
"^$slot_name\0");
my ($tmp) = %consumed;
if ($tmp =~ /error: 2/) { undef(%consumed); }
if (%slot && !%consumed) {
$slot{'type'} = 'deleted';
my $ret = &Apache::lonnet::cput('slots', {$slot_name => \%slot},
$cdom, $cnum);
if ($ret eq 'ok') {
$r->print('
'.&mt('Slot [_1] marked as deleted.',''.$slot_name.'').'
');
} else {
$r->print('
'.&mt('An error occurred when attempting to delete slot: [_1]',''.$slot_name.'')." ($ret)
");
}
} else {
if (%consumed) {
$r->print('
'.&mt('Slot [_1] has active reservations.',''.$slot_name.'').'
');
} else {
$r->print('
'.&mt('Slot [_1] does not exist.',''.$slot_name.'').'
');
}
}
sub get_slot {
my ($r,$symb,$conflictable_slot,$inhibit_return_link)=@_;
my %slot=&Apache::lonnet::get_slot($env{'form.slotname'});
my $slot_name=&check_for_conflict($symb,$env{'form.slotname'},\%slot);
if ($slot_name =~ /^error: (.*)/) {
$r->print('
'
.&mt('An error occurred while attempting to make a reservation. ([_1])',$1)
.'
');
&return_link($r);
return 0;
}
if ($slot_name && $slot_name ne $conflictable_slot) {
my %slot=&Apache::lonnet::get_slot($slot_name);
my $description1=&get_description($slot_name,\%slot);
%slot=&Apache::lonnet::get_slot($env{'form.slotname'});
my $description2=&get_description($env{'form.slotname'},\%slot);
if ($slot_name ne $env{'form.slotname'}) {
$r->print(<
STUFF
$r->print('
'.&mt('Reservation currently unchanged').'
');
if ($slot_name ne '') {
$r->print('
'.&mt('To complete the transaction you [_1]must confirm[_2] you want to [_3]process the change[_4] to [_5].'
,'','','','',''.$description2.'')
.' '
.&mt('Or you can choose to [_1]make no change[_2] and continue[_2] with the reservation you already had: [_3].'
,'','',''.$description1.'')
.'
'
.''
.(' 'x3)
.''
.'
');
}
$r->print(<
STUFF
} else {
$r->print('
'.&mt('Already have a reservation: [_1].',$description1).'
');
&return_link($r);
}
return 0;
}
my ($cnum,$cdom)=&get_course();
my $reserved=&make_reservation($env{'form.slotname'},
\%slot,$symb,$cnum,$cdom);
my $description=&get_description($env{'form.slotname'},\%slot);
if (defined($reserved)) {
my $retvalue = 0;
if ($slot_name =~ /^error: (.*)/) {
$r->print('
'
.&mt('An error occurred while attempting to make a reservation. ([_1])',$1)
.'
');
} elsif ($reserved > -1) {
$r->print('
'.&mt('Successfully signed up: [_1]',$description).'
');
$retvalue = 1;
my $person = &Apache::loncommon::plainname($env{'user.name'},$env{'user.domain'});
my $subject = &mt('Reservation change: [_1]',$description);
my $msgbody = &mt('Successful reservation by [_1] for [_2].',$person,$description);
my $msg = &slot_change_messaging($slot{'reservationmsg'},$subject,$msgbody,'reserve');
if ($msg) {
$r->print($msg);
}
} elsif ($reserved < 0) {
$r->print('
'.&mt('Already reserved: [_1]',$description).'
');
}
if (!$inhibit_return_link) { &return_link($r); }
return 1;
}
my %lt = &Apache::lonlocal::texthash(
'request' => 'Availibility list',
'try' => 'Try again?',
'or' => 'or',
);
my $extra_input;
if ($conflictable_slot) {
$extra_input='';
}
$r->print('
'.&mt('[_1]Failed[_2] to reserve a slot for [_3].','','',$description).'
');
$r->print(<
$lt{'or'}
STUFF
if (!$inhibit_return_link) {
$r->print(&mt('or').'');
&return_link($r);
} else {
$r->print('');
}
return 0;
}
sub allowed_slot {
my ($slot_name,$slot,$symb,$slots,$consumed_uniqueperiods)=@_;
#already started
if ($slot->{'starttime'} < time) {
return 0;
}
&Apache::lonxml::debug("$slot_name starttime good");
#already ended
if ($slot->{'endtime'} < time) {
return 0;
}
&Apache::lonxml::debug("$slot_name endtime good");
# not allowed to pick this one
if (defined($slot->{'type'})
&& $slot->{'type'} ne 'schedulable_student') {
return 0;
}
&Apache::lonxml::debug("$slot_name type good");
# reserve time not yet started
if ($slot->{'startreserve'} > time) {
return 0;
}
&Apache::lonxml::debug("$slot_name reserve good");
my $userallowed=0;
# its for a different set of users
if (defined($slot->{'allowedsections'})) {
if (!defined($env{'request.role.sec'})
&& grep(/^No section assigned$/,
split(',',$slot->{'allowedsections'}))) {
$userallowed=1;
}
if (defined($env{'request.role.sec'})
&& grep(/^\Q$env{'request.role.sec'}\E$/,
split(',',$slot->{'allowedsections'}))) {
$userallowed=1;
}
if (defined($env{'request.course.groups'})) {
my @groups = split(/:/,$env{'request.course.groups'});
my @allowed_sec = split(',',$slot->{'allowedsections'});
foreach my $group (@groups) {
if (grep {$_ eq $group} (@allowed_sec)) {
$userallowed=1;
last;
}
}
}
}
&Apache::lonxml::debug("$slot_name sections is $userallowed");
# its for a different set of users
if (defined($slot->{'allowedusers'})
&& grep(/^\Q$env{'user.name'}:$env{'user.domain'}\E$/,
split(',',$slot->{'allowedusers'}))) {
$userallowed=1;
}
if (!defined($slot->{'allowedusers'})
&& !defined($slot->{'allowedsections'})) {
$userallowed=1;
}
&Apache::lonxml::debug("$slot_name user is $userallowed");
return 0 if (!$userallowed);
# not allowed for this resource
if (defined($slot->{'symb'})
&& $slot->{'symb'} ne $symb) {
return 0;
}
my $conflict = &check_for_conflict($symb,$slot_name,$slot,$slots,
$consumed_uniqueperiods);
if ($conflict =~ /^error: /) {
return 0;
} elsif ($conflict ne '') {
if ($slots->{$conflict}{'starttime'} < time) {
return 0;
}
}
&Apache::lonxml::debug("$slot_name symb good");
return 1;
}
sub get_description {
my ($slot_name,$slot)=@_;
my $description=$slot->{'description'};
if (!defined($description)) {
$description=&mt('[_1] From [_2] to [_3]',$slot_name,
&Apache::lonlocal::locallocaltime($slot->{'starttime'}),
&Apache::lonlocal::locallocaltime($slot->{'endtime'}));
}
return $description;
}
sub show_choices {
my ($r,$symb,$formname)=@_;
my ($cnum,$cdom)=&get_course();
my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);
my $consumed_uniqueperiods = &get_consumed_uniqueperiods(\%slots);
if (ref($consumed_uniqueperiods) eq 'HASH') {
if (&Apache::lonnet::error(%$consumed_uniqueperiods)) {
$r->print(''.
&mt('An error occurred determining slot availability').
'');
return;
}
} elsif ($consumed_uniqueperiods =~ /^error: /) {
$r->print(''.
&mt('An error occurred determining slot availability').
'');
return;
}
my (@available,$output);
&Apache::lonxml::debug("Checking Slots");
my @got_slots=&check_for_reservation($symb,'allslots');
if ($got_slots[0] =~ /^error: /) {
$r->print(''.
&mt('An error occurred determining slot availability').
'');
return;
}
foreach my $slot (sort
{ return $slots{$a}->{'starttime'} <=> $slots{$b}->{'starttime'} }
(keys(%slots))) {
&Apache::lonxml::debug("Checking Slot $slot");
next if (!&allowed_slot($slot,$slots{$slot},$symb,\%slots,
$consumed_uniqueperiods));
push(@available,$slot);
}
if (!@available) {
$output = &mt('No available times.');
if ($env{'form.command'} ne 'manageresv') {
$output .= ' '.
&mt('Return to last resource').'';
}
$r->print($output);
return;
}
if ($env{'form.command'} eq 'manageresv') {
$output = '
';
} else {
$output = &Apache::loncommon::start_data_table();
}
foreach my $slot (@available) {
my $description=&get_description($slot,$slots{$slot});
my $form;
if ((grep(/^\Q$slot\E$/,@got_slots)) ||
&space_available($slot,$slots{$slot},$symb)) {
my $text=&mt('Select');
my $command='get';
if (grep(/^\Q$slot\E$/,@got_slots)) {
$text=&mt('Drop Reservation');
$command='release';
} else {
my $conflict = &check_for_conflict($symb,$slot,$slots{$slot},
\%slots,
$consumed_uniqueperiods);
if ($conflict) {
if ($conflict =~ /^error: /) {
$form = ''.
&mt('Slot: [_1] has unknown status.',$description).
'';
} else {
$text=&mt('Change Reservation');
$command='get';
}
}
}
my $escsymb=&escape($symb);
if (!$form) {
if ($formname) {
$formname = 'name="'.$formname.'" ';
}
my $context = 'user';
if ($env{'form.command'} eq 'manageresv') {
$context = 'usermanage';
}
$form=<
STUFF
}
} else {
$form = &mt('Unavailable');
}
if ($env{'form.command'} eq 'manageresv') {
$output .= '
');
}
if (!keys(%slots)) {
if ($crstype eq 'Community') {
$r->print('
'.&mt('No slots have been created in this community.').'
');
} else {
$r->print('
'.&mt('No slots have been created in this course.').'
');
}
return;
}
my %Saveable_Parameters = ('show' => 'array',
'when' => 'scalar',
'order' => 'scalar',
'deleted' => 'scalar',
'name_filter_type' => 'scalar',
'name_filter_value' => 'scalar',
);
&Apache::loncommon::store_course_settings('slotrequest',
\%Saveable_Parameters);
&Apache::loncommon::restore_course_settings('slotrequest',
\%Saveable_Parameters);
&Apache::grades::init_perm();
my ($classlist,$section,$fullname)=&Apache::grades::getclasslist('all');
&Apache::grades::reset_perm();
# what to display filtering
my %show_fields=&Apache::lonlocal::texthash(
'name' => 'Slot Name',
'description' => 'Description',
'type' => 'Type',
'starttime' => 'Start time',
'endtime' => 'End Time',
'startreserve' => 'Time students can start reserving',
'reservationmsg' => 'Message triggered by reservation',
'secret' => 'Secret Word',
'space' => '# of students/max',
'ip' => 'IP or DNS restrictions',
'symb' => 'Resource slot is restricted to.',
'allowedsections' => 'Sections slot is restricted to.',
'allowedusers' => 'Users slot is restricted to.',
'uniqueperiod' => 'Period of time slot is unique',
'scheduled' => 'Scheduled Students',
'proctor' => 'List of proctors');
if ($crstype eq 'Community') {
$show_fields{'startreserve'} = &mt('Time members can start reserving');
$show_fields{'scheduled'} = &mt('Scheduled Members');
}
my @show_order=('name','description','type','starttime','endtime',
'startreserve','reservationmsg','secret','space','ip','symb',
'allowedsections','allowedusers','uniqueperiod',
'scheduled','proctor');
my @show =
(exists($env{'form.show'})) ? &Apache::loncommon::get_env_multiple('form.show')
: keys(%show_fields);
my %show = map { $_ => 1 } (@show);
#when filtering setup
my %when_fields=&Apache::lonlocal::texthash(
'now' => 'Open now',
'nextweek' => 'Open within the next week',
'lastweek' => 'Were open last week',
'willopen' => 'Will open later',
'wereopen' => 'Were open',
'any' => 'Anytime',
);
my @when_order=('any','now','nextweek','lastweek','willopen','wereopen');
$when_fields{'select_form_order'} = \@when_order;
my $when = (exists($env{'form.when'})) ? $env{'form.when'}
: 'now';
#display of students setup
my %stu_display_fields=
&Apache::lonlocal::texthash('username' => 'User name',
'fullname' => 'Full name',
);
my @stu_display_order=('fullname','username');
my @stu_display =
(exists($env{'form.studisplay'})) ? &Apache::loncommon::get_env_multiple('form.studisplay')
: keys(%stu_display_fields);
my %stu_display = map { $_ => 1 } (@stu_display);
#name filtering setup
my %name_filter_type_fields=
&Apache::lonlocal::texthash('substring' => 'Substring',
'exact' => 'Exact',
#'reg' => 'Regular Expression',
);
my @name_filter_type_order=('substring','exact');
$name_filter_type_fields{'select_form_order'} = \@name_filter_type_order;
my $name_filter_type =
(exists($env{'form.name_filter_type'})) ? $env{'form.name_filter_type'}
: 'substring';
my $name_filter = {'type' => $name_filter_type,
'value' => $env{'form.name_filter_value'},};
#deleted slot filtering
#default to hide if no value
$env{'form.deleted'} ||= 'hide';
my $hide_radio =
&Apache::lonhtmlcommon::radio('deleted',$env{'form.deleted'},'hide');
my $show_radio =
&Apache::lonhtmlcommon::radio('deleted',$env{'form.deleted'},'show');
$r->print('');
return;
}
sub manage_reservations {
my ($r,$crstype) = @_;
my $navmap = Apache::lonnavmaps::navmap->new();
$r->print('
'
.&mt('Instructors may use a reservation system to place restrictions on when and where assignments can be worked on.')
.' '
.&mt('One example is for management of laboratory space, which is only available at certain times, and has a limited number of seats.')
.'
'
);
if (!defined($navmap)) {
$r->print('
');
if ($crstype eq 'Community') {
$r->print(&mt('Unable to retrieve information about community contents'));
} else {
$r->print(&mt('Unable to retrieve information about course contents'));
}
$r->print('
');
&Apache::lonnet::logthis('Manage Reservations - could not create navmap object in '.lc($crstype).':'.$env{'request.course.id'});
return;
}
my (%parent,%shownparent,%container,%container_title,%contents);
my ($depth,$count,$reservable,$lastcontainer,$rownum) = (0,0,0,0,0);
my @backgrounds = ("LC_odd_row","LC_even_row");
my $numcolors = scalar(@backgrounds);
my $location=&Apache::loncommon::lonhttpdurl("/adm/lonIcons/whitespace_21.gif");
my $slotheader = '
'.
&mt('Your reservation status for any such assignments is listed below:').
'
'.
'
'."\n";
my $shownheader = 0;
my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef);
while (my $resource = $it->next()) {
if ($resource == $it->BEGIN_MAP()) {
$depth++;
$parent{$depth} = $lastcontainer;
}
if ($resource == $it->END_MAP()) {
$depth--;
$lastcontainer = $parent{$depth};
}
if (ref($resource)) {
my $symb = $resource->symb();
my $ressymb = $symb;
$contents{$lastcontainer} ++;
next if (!$resource->is_problem() && !$resource->is_sequence() &&
!$resource->is_page());
$count ++;
if (($resource->is_sequence()) || ($resource->is_page())) {
$lastcontainer = $count;
$container{$lastcontainer} = $resource;
$container_title{$lastcontainer} = $resource->compTitle();
}
if ($resource->is_problem()) {
my ($useslots) = $resource->slot_control();
next if (($useslots eq '') || ($useslots =~ /^\s*no\s*$/i));
my ($msg,$get_choices,$slotdescription);
my $title = $resource->compTitle();
my $status = $resource->simpleStatus('0');
my ($slot_status,$date,$slot_name) = $resource->check_for_slot('0');
if ($slot_name ne '') {
my %slot=&Apache::lonnet::get_slot($slot_name);
$slotdescription=&get_description($slot_name,\%slot);
}
if ($slot_status == $resource->NOT_IN_A_SLOT) {
$msg=&mt('No current reservation.');
$get_choices = 1;
} elsif ($slot_status == $resource->NEEDS_CHECKIN) {
$msg=''.&mt('Reserved:').
' '.$slotdescription.' '.
&mt('Access requires proctor validation.');
} elsif ($slot_status == $resource->WAITING_FOR_GRADE) {
$msg=&mt('Submitted and currently in grading queue.');
} elsif ($slot_status == $resource->CORRECT) {
$msg=&mt('Problem is unavailable.');
} elsif ($slot_status == $resource->RESERVED) {
$msg=''.&mt('Reserved:').
' '.$slotdescription.' '.
&mt('Problem is currently available.');
} elsif ($slot_status == $resource->RESERVED_LOCATION) {
$msg=''.&mt('Reserved:').
' '.$slotdescription.' '.
&mt('Problem is available at a different location.');
$get_choices = 1;
} elsif ($slot_status == $resource->RESERVED_LATER) {
$msg=''.&mt('Reserved:').
' '.$slotdescription.' '.
&mt('Problem will be available later.');
$get_choices = 1;
} elsif ($slot_status == $resource->RESERVABLE) {
$msg=&mt('Reservation needed');
$get_choices = 1;
} elsif ($slot_status == $resource->NOTRESERVABLE) {
$msg=&mt('Reservation needed: none available.');
} elsif ($slot_status == $resource->UNKNOWN) {
$msg=&mt('Unable to determine status due to network problems.');
} else {
if ($status != $resource->OPEN) {
$msg = &Apache::lonnavmaps::getDescription($resource,'0');
}
}
$reservable ++;
my $treelevel = $depth;
my $higherup = $lastcontainer;
if ($depth > 1) {
my @maprows;
while ($treelevel > 1) {
if (ref($container{$higherup})) {
my $res = $container{$higherup};
last if (defined($shownparent{$higherup}));
my $maptitle = $res->compTitle();
my $type = 'sequence';
if ($res->is_page()) {
$type = 'page';
}
&show_map_row($treelevel,$location,$type,$maptitle,
\@maprows);
$shownparent{$higherup} = 1;
}
$treelevel --;
$higherup = $parent{$treelevel};
}
foreach my $item (@maprows) {
$rownum ++;
my $bgcolor = $backgrounds[$rownum % $numcolors];
if (!$shownheader) {
$r->print($slotheader);
$shownheader = 1;
}
$r->print('
'.$item.'
'."\n");
}
}
$rownum ++;
my $bgcolor = $backgrounds[$rownum % $numcolors];
if (!$shownheader) {
$r->print($slotheader);
$shownheader = 1;
}
$r->print('
'."\n");
for (my $i=0; $i<$depth; $i++) {
$r->print('');
}
my $result = ''.
''.$title.''.(' ' x6).'
';
my $hasaction;
if ($status == $resource->OPEN) {
if ($get_choices) {
$hasaction = 1;
}
}
if ($hasaction) {
$result .= '
'.$msg.'
'.
'
'.(' ' x6);
} else {
$result .= '
'.$msg.'
';
}
$r->print($result);
if ($hasaction) {
my $formname = 'manageres_'.$reservable;
&show_choices($r,$symb,$formname);
$r->print('');
}
$r->print('
');
}
}
}
if ($shownheader) {
$r->print('
');
}
if (!$reservable) {
$r->print('');
if ($crstype eq 'Community') {
$r->print(&mt('No community items currently require a reservation to gain access.'));
} else {
$r->print(&mt('No course items currently require a reservation to gain access.'));
}
$r->print('');
}
$r->print('
'."\n";
unshift (@{$maprows},$output);
return;
}
sub show_reservations {
my ($r,$uname,$udom) = @_;
if (!defined($uname)) {
$uname = $env{'user.name'};
}
if (!defined($udom)) {
$udom = $env{'user.domain'};
}
my $formname = 'slotlog';
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my $crstype = &Apache::loncommon::course_type();
my %log=&Apache::lonnet::dump('nohist_'.$cdom.'_'.$cnum.'_slotlog',$udom,$uname);
if ($env{'form.origin'} eq 'aboutme') {
$r->print('
');
my $name = &Apache::loncommon::plainname($env{'form.uname'},$env{'form.udom'},
'firstname');
if ($crstype eq 'Community') {
$r->print(&mt('History of member-reservable slots for: [_1]',
$name));
} else {
$r->print(&mt('History of student-reservable slots for: [_1]',
$name));
}
$r->print('
');
}
$r->print('');
return;
}
sub show_reservations_log {
my ($r) = @_;
my $badslot;
my $crstype = &Apache::loncommon::course_type();
if ($env{'form.slotname'} eq '') {
$r->print('
'.&mt('No slot name provided').'
');
$badslot = 1;
} else {
my %slot=&Apache::lonnet::get_slot($env{'form.slotname'});
if (keys(%slot) == 0) {
$r->print('
');
$badslot = 1;
} elsif ($slot{type} ne 'schedulable_student') {
my $description = &get_description($env{'form.slotname'},\%slot);
$r->print('
');
if ($crstype eq 'Community') {
$r->print(&mt('Reservation history unavailable for non-member-reservable slot: [_1].',$description));
} else {
$r->print(&mt('Reservation history unavailable for non-student-reservable slot: [_1].',$description));
}
$r->print('
');
return;
}
my $formname = 'reservationslog';
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my %slotlog=&Apache::lonnet::dump('nohist_slotreservationslog',$cdom,$cnum);
if ((keys(%slotlog))[0]=~/^error\:/) { undef(%slotlog); }
my (%log,@allsymbs);
if (keys(%slotlog)) {
foreach my $key (keys(%slotlog)) {
if (ref($slotlog{$key}) eq 'HASH') {
if (ref($slotlog{$key}{'logentry'}) eq 'HASH') {
if ($slotlog{$key}{'logentry'}{'slot'} eq $env{'form.slotname'}) {
$log{$key} = $slotlog{$key};
if ($slotlog{$key}{'logentry'}{'symb'} ne '') {
push(@allsymbs,$slotlog{$key}{'logentry'}{'symb'});
}
}
}
}
}
}
$r->print(''.
'
';
my $startform =
&Apache::lonhtmlcommon::date_setter($formname,'log_start_date',
$curr->{'log_start_date'},undef,
undef,undef,undef,undef,undef,undef,$nolink);
my $endform =
&Apache::lonhtmlcommon::date_setter($formname,'log_end_date',
$curr->{'log_end_date'},undef,
undef,undef,undef,undef,undef,undef,$nolink);
my $crstype = &Apache::loncommon::course_type();
my %lt = &reservationlog_contexts($crstype);
$output .= '
'.&mt('Window during which changes occurred:').
'
'.&mt('After:').
'
'.$startform.'
'.&mt('Before:').'
'.
$endform.'
';
if (ref($allsymbs) eq 'ARRAY') {
$output .= '
'.&mt('Resource').' '.
'
'.
&mt('Context:').'
';
} else {
$output .= '
'.&mt('Action').' '.
'
';
}
$output .= '
'.
'
'.
&mt('Only changes made from servers running LON-CAPA [_1] or later are displayed.'
,'2.9.0');
if ($version) {
$output .= ' '.&mt('This LON-CAPA server is version [_1]',$version);
}
$output .= '
';
return $output;
}
sub slot_change_messaging {
my ($setting,$subject,$msg,$action) = @_;
my $user = $env{'user.name'};
my $domain = $env{'user.domain'};
my ($message_status,$comment_status);
if ($setting eq 'only_student'
|| $setting eq 'student_and_user_notes_screen') {
$message_status =
&Apache::lonmsg::user_normal_msg($user,$domain,$subject,$msg);
$message_status = '
'.&mt('Entry added to course record (viewable by instructor): [_1]',
$comment_status).'
';
}
if ($message_status || $comment_status) {
my $msgtitle;
if ($action eq 'reserve') {
$msgtitle = &mt('Status of messages about saved reservation');
} elsif ($action eq 'release') {
$msgtitle = &mt('Status of messages about dropped reservation');
} elsif ($action eq 'nochange') {
$msgtitle = &mt('Status of messages about unchanged existing reservation');
}
return ''.$msgtitle.''
.'
'
.$message_status
.$comment_status
.'
';
}
}
sub upload_start {
my ($r)=@_;
$r->print(
&Apache::grades::checkforfile_js()
.'
'.&mt('Specify a file containing the slot definitions.').'
'
.''
);
}
sub csvuploadmap_header {
my ($r,$datatoken,$distotal)= @_;
my $javascript;
if ($env{'form.upfile_associate'} eq 'reverse') {
$javascript=&csvupload_javascript_reverse_associate();
} else {
$javascript=&csvupload_javascript_forward_associate();
}
my $checked=(($env{'form.noFirstLine'})?' checked="checked"':'');
my $ignore=&mt('Ignore First Line');
my $help_field = &Apache::loncommon::help_open_topic('Slot SelectingField');
$r->print(<
Identify fields $help_field
Total number of records found in file: $distotal
Enter as many fields as you can. The system will inform you and bring you back
to this page if the data selected is insufficient to create the slots.
ENDPICK
return '';
}
sub csvuploadmap_footer {
my ($request,$i,$keyfields) =@_;
my $buttontext = &mt('Create Slots');
$request->print(<
ENDPICK
}
sub csvupload_javascript_reverse_associate {
my $error1=&mt('You need to specify the name, starttime, endtime and a type');
return(<[0].','; }
chop($keyfields);
} else {
unshift(@fields,['none','']);
$i=&Apache::loncommon::csv_samples_select_table($r,\@records,
\@fields);
my %sone=&Apache::loncommon::record_sep($records[0]);
$keyfields=join(',',sort(keys(%sone)));
}
}
&csvuploadmap_footer($r,$i,$keyfields);
return '';
}
sub csvupload_fields {
return (['name','Slot name'],
['type','Type of slot'],
['starttime','Start Time of slot'],
['endtime','End Time of slot'],
['startreserve','Reservation Start Time'],
['reservationmsg','Message when reservation changed'],
['ip','IP or DNS restriction'],
['proctor','List of proctor ids'],
['description','Slot Description'],
['maxspace','Maximum number of reservations'],
['symb','Resource Restriction'],
['uniqueperiod','Date range of slot exclusion'],
['secret','Secret word proctor uses to validate'],
['allowedsections','Sections slot is restricted to'],
['allowedusers','Users slot is restricted to'],
);
}
sub csv_upload_assign {
my ($r,$mgr)= @_;
&Apache::loncommon::load_tmp_file($r);
my @slotdata = &Apache::loncommon::upfile_record_sep();
if ($env{'form.noFirstLine'}) { shift(@slotdata); }
my %fields=&Apache::grades::get_fields();
$r->print('
'.&mt('Creating Slots').'
');
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $countdone=0;
my @errors;
foreach my $slot (@slotdata) {
my %slot;
my %entries=&Apache::loncommon::record_sep($slot);
my $domain;
my $name=$entries{$fields{'name'}};
if ($name=~/^\s*$/) {
push(@errors,"Did not create slot with no name");
next;
}
if ($name=~/\s/) {
push(@errors,"$name not created -- Name must not contain spaces");
next;
}
if ($name=~/\W/) {
push(@errors,"$name not created -- Name must contain only letters, numbers and _");
next;
}
if ($entries{$fields{'type'}}) {
$slot{'type'}=$entries{$fields{'type'}};
} else {
$slot{'type'}='preassigned';
}
if ($slot{'type'} ne 'preassigned' &&
$slot{'type'} ne 'schedulable_student') {
push(@errors,"$name not created -- invalid type ($slot{'type'}) must be either preassigned or schedulable_student");
next;
}
if ($entries{$fields{'starttime'}}) {
$slot{'starttime'}=&UnixDate($entries{$fields{'starttime'}},"%s");
}
if ($entries{$fields{'endtime'}}) {
$slot{'endtime'}=&UnixDate($entries{$fields{'endtime'}},"%s");
}
# start/endtime must be defined and greater than zero
if (!$slot{'starttime'}) {
push(@errors,"$name not created -- Invalid start time");
next;
}
if (!$slot{'endtime'}) {
push(@errors,"$name not created -- Invalid end time");
next;
}
if ($slot{'starttime'} > $slot{'endtime'}) {
push(@errors,"$name not created -- Slot starts after it ends");
next;
}
if ($entries{$fields{'startreserve'}}) {
$slot{'startreserve'}=
&UnixDate($entries{$fields{'startreserve'}},"%s");
}
if (defined($slot{'startreserve'})
&& $slot{'startreserve'} > $slot{'starttime'}) {
push(@errors,"$name not created -- Slot's reservation start time is after the slot's start time.");
next;
}
if ($slot{'type'} eq 'schedulable_student') {
if ($entries{$fields{'reservationmsg'}}) {
if (($entries{$fields{'reservationmsg'}} eq 'only_student') ||
($entries{$fields{'reservationmsg'}} eq 'student_and_user_notes_screen')) {
$slot{'reservationmsg'}=$entries{$fields{'reservationmsg'}};
} else {
unless (($entries{$fields{'reservationmsg'}} eq 'none') ||
($entries{$fields{'reservationmsg'}} eq '')) {
push(@errors,"$name -- Slot's reservationmsg setting ignored - not one of: 'only_student', 'student_and_user_notes_screen', 'none' or ''");
}
}
}
}
foreach my $key ('ip','proctor','description','maxspace',
'secret','symb') {
if ($entries{$fields{$key}}) {
$slot{$key}=$entries{$fields{$key}};
}
}
if ($entries{$fields{'uniqueperiod'}}) {
my ($start,$end)=split(',',$entries{$fields{'uniqueperiod'}});
my @times=(&UnixDate($start,"%s"),
&UnixDate($end,"%s"));
$slot{'uniqueperiod'}=\@times;
}
if (defined($slot{'uniqueperiod'})
&& $slot{'uniqueperiod'}[0] > $slot{'uniqueperiod'}[1]) {
push(@errors,"$name not created -- Slot's unique period start time is later than the unique period's end time.");
next;
}
&Apache::lonnet::cput('slots',{$name=>\%slot},$cdom,$cname);
$r->print('.');
$r->rflush();
$countdone++;
}
$r->print('