--- loncom/interface/slotrequest.pm 2005/09/09 18:27:56 1.13 +++ loncom/interface/slotrequest.pm 2005/11/21 19:50:36 1.34 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler for requesting to have slots added to a students record # -# $Id: slotrequest.pm,v 1.13 2005/09/09 18:27:56 albertel Exp $ +# $Id: slotrequest.pm,v 1.34 2005/11/21 19:50:36 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -34,6 +34,7 @@ use Apache::Constants qw(:common :http : use Apache::loncommon(); use Apache::lonlocal; use Apache::lonnet; +use Date::Manip; sub fail { my ($r,$code)=@_; @@ -52,11 +53,10 @@ sub fail { } sub start_page { - my ($r)=@_; + my ($r,$title)=@_; my $html=&Apache::lonxml::xmlbegin(); - $r->print($html.''. - &mt('Request another Worktime').''); - $r->print(&Apache::loncommon::bodytag('Requesting another Worktime')); + $r->print($html.''.&mt($title).''); + $r->print(&Apache::loncommon::bodytag($title)); } sub end_page { @@ -231,17 +231,55 @@ sub make_reservation { return undef; } +sub remove_registration { + my ($r) = @_; + my $name = &Apache::loncommon::plainname($env{'form.uname'}, + $env{'form.udom'}); + + my $title = &Apache::lonnet::gettitle($env{'form.symb'}); + + my $hidden_input; + foreach my $parm ('uname','udom','slotname','entry','symb') { + $hidden_input .= + '&\'').'" />'."\n"; + } + $r->print(<<"END_CONFIRM"); +

Remove $name from slot $env{'form.slotname'} for $title

+
+ + $hidden_input + +
+
+ + +
+END_CONFIRM + +} + sub release_slot { - my ($r,$symb,$slot_name,$inhibit_return_link)=@_; + my ($r,$symb,$slot_name,$inhibit_return_link,$mgr)=@_; if ($slot_name eq '') { $slot_name=$env{'form.slotname'}; } my ($cnum,$cdom)=&get_course(); + my ($uname,$udom) = ($env{'user.name'}, $env{'user.domain'}); + if ($mgr eq 'F' + && defined($env{'form.uname'}) && defined($env{'form.udom'})) { + ($uname,$udom) = ($env{'form.uname'}, $env{'form.udom'}); + } + + if ($mgr eq 'F' + && defined($env{'form.symb'})) { + $symb = $env{'form.symb'}; + } + # get parameter string, check for existance, rebuild string with the slot - my @slots = split(/:/,&Apache::lonnet::EXT("resource.0.availablestudent", - $symb,$env{'user.domain'}, - $env{'user.name'})); + $symb,$udom,$uname)); + my @new_slots; foreach my $exist_slot (@slots) { if ($exist_slot eq $slot_name) { next; } @@ -253,21 +291,24 @@ sub release_slot { my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum, "^$slot_name\0"); foreach my $entry (keys(%consumed)) { - if ( $consumed{$entry}->{'name'} eq - ($env{'user.name'}.'@'.$env{'user.domain'}) ) { + if ( $consumed{$entry}->{'name'} eq ($uname.'@'.$udom) ) { &Apache::lonnet::del('slot_reservations',[$entry], $cdom,$cnum); } } + # store new parameter string my $result=&Apache::lonparmset::storeparm_by_symb($symb, '0_availablestudent', 1, $new_param, 'string', - $env{'user.name'}, - $env{'user.domain'}); + $uname,$udom); my %slot=&Apache::lonnet::get_slot($slot_name); my $description=&get_description($env{'form.slotname'},\%slot); $r->print("

Released Reservation: $description

"); + if ($mgr eq 'F') { + $r->print('

'. + &mt('Return to slot list').'

'); + } if (!$inhibit_return_link) { $r->print('

'. &mt('Return to last resource').'

'); @@ -275,6 +316,38 @@ sub release_slot { return 1; } +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"); + + if (%slot && !%consumed) { + $slot{'type'} = 'deleted'; + my $ret = &Apache::lonnet::cput('slots', {$slot_name => \%slot}, + $cdom, $cnum); + if ($ret eq 'ok') { + $r->print("

Slot $slot_name marked as deleted.

"); + } else { + $r->print("

An error ($ret) occurse when attempting to delete Slot $slot_name.

"); + } + } else { + if (%consumed) { + $r->print("

Slot $slot_name has active reservations.

"); + } else { + $r->print("

Slot $slot_name does not exist.

"); + } + } + $r->print('

'. + &mt('Return to slot list').'

'); + $r->print('

'. + &mt('Return to last resource').'

'); +} + sub get_slot { my ($r,$symb)=@_; @@ -450,27 +523,175 @@ STUFF $r->print(''); } +sub to_show { + my ($when,$slot) = @_; + my $time=time; + my $week=60*60*24*7; + if ($when eq 'now') { + if ($time > $slot->{'starttime'} && + $time < $slot->{'endtime'}) { + return 1; + } + return 0; + } elsif ($when eq 'nextweek') { + if ( ($time < $slot->{'starttime'} && + ($time+$week) > $slot->{'starttime'}) + || + ($time < $slot->{'endtime'} && + ($time+$week) > $slot->{'endtime'}) ) { + return 1; + } + return 0; + } elsif ($when eq 'lastweek') { + if ( ($time > $slot->{'starttime'} && + ($time-$week) < $slot->{'starttime'}) + || + ($time > $slot->{'endtime'} && + ($time-$week) < $slot->{'endtime'}) ) { + return 1; + } + return 0; + } elsif ($when eq 'willopen') { + if ($time < $slot->{'starttime'}) { + return 1; + } + return 0; + } elsif ($when eq 'wereopen') { + if ($time > $slot->{'endtime'}) { + return 1; + } + return 0; + } + + return 1; +} + +sub remove_link { + my ($slotname,$entry,$uname,$udom,$symb) = @_; + + $slotname = &Apache::lonnet::escape($slotname); + $entry = &Apache::lonnet::escape($entry); + $uname = &Apache::lonnet::escape($uname); + $udom = &Apache::lonnet::escape($udom); + $symb = &Apache::lonnet::escape($symb); + + my $remove= &mt('Remove'); + + return <<"END_LINK"; + ($remove) +END_LINK + +} + sub show_table { - my ($r,$symb)=@_; + my ($r,$mgr)=@_; my ($cnum,$cdom)=&get_course(); my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum); + if ( (keys(%slots))[0] =~ /^error: 2 /) { + undef(%slots); + } my $available; - $r->print(' + if ($mgr eq 'F') { + $r->print('
'); + $r->print('
+ + +'); + $r->print('
+ +'); + $r->print('
'); + } + + my %Saveable_Parameters = ('show' => 'array', + 'when' => 'scalar', + 'order' => 'scalar'); + + &Apache::loncommon::store_course_settings('slotrequest',\%Saveable_Parameters); + &Apache::loncommon::restore_course_settings('slotrequest',\%Saveable_Parameters); + + 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', + 'secret' => 'Secret Word', + 'maxspace' => 'Maxium # of students', + 'ip' => 'IP or DNS restrictions', + 'symb' => 'Resource slot is restricted to.', + 'uniqueperiod' => 'Period of time slot is unique', + 'proctor' => 'List of proctors'); + my @show_order=('name','description','type','starttime','endtime', + 'startreserve','secret','maxspace','ip','symb', + 'uniqueperiod','proctor'); + my @show = + (exists($env{'form.show'})) ? &Apache::loncommon::get_env_multiple('form.show') + : keys(%show_fields); + my %show = map { $_ => 1 } (@show); + + 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'); + my @when_order=('now','nextweek','lastweek','willopen','wereopen'); + $when_fields{'select_form_order'} = \@when_order; + my $when = (exists($env{'form.when'})) ? $env{'form.when'} + : 'now'; + + $r->print(' +'); + $r->print('
'); + $r->print('
'.&mt('Show').''.&mt('Open').'
'.&Apache::loncommon::multiple_select_form('show',\@show,6,\%show_fields,\@show_order). + ''.&Apache::loncommon::select_form($when,'when',%when_fields). + '
'); + $r->print(''); + $r->print('

'); + my $linkstart=' - Slot name - Type - Description - Start Time - End Time - Max space - Scheduled Students - Proctors - Unique Period -'); - foreach my $slot (sort - { return $slots{$a}->{'starttime'} <=> $slots{$b}->{'starttime'} } - (keys(%slots))) { + '); + foreach my $which (@show_order) { + if ($which ne 'proctor' && exists($show{$which})) { + $r->print(''.$linkstart.$which.'">'.$show_fields{$which}.''); + } + } + $r->print('Scheduled Students'); + + my %name_cache; + my $slotsort = sub { + if ($env{'form.order'}=~/^(type|description|endtime|startreserve|maxspace|ip|symb)$/) { + if (lc($slots{$a}->{$env{'form.order'}}) + ne lc($slots{$b}->{$env{'form.order'}})) { + return (lc($slots{$a}->{$env{'form.order'}}) + cmp lc($slots{$b}->{$env{'form.order'}})); + } + } elsif ($env{'form.order'} eq 'name') { + if (lc($a) cmp lc($b)) { + return lc($a) cmp lc($b); + } + } elsif ($env{'form.order'} eq 'uniqueperiod') { + + if ($slots{$a}->{'uniqueperiod'}[0] + ne $slots{$b}->{'uniqueperiod'}[0]) { + return ($slots{$a}->{'uniqueperiod'}[0] + cmp $slots{$b}->{'uniqueperiod'}[0]); + } + if ($slots{$a}->{'uniqueperiod'}[1] + ne $slots{$b}->{'uniqueperiod'}[1]) { + return ($slots{$a}->{'uniqueperiod'}[1] + cmp $slots{$b}->{'uniqueperiod'}[1]); + } + } + return $slots{$a}->{'starttime'} <=> $slots{$b}->{'starttime'}; + }; + foreach my $slot (sort $slotsort (keys(%slots))) { + if (!&to_show($when,$slots{$slot})) { next; } if (defined($slots{$slot}->{'type'}) && $slots{$slot}->{'type'} ne 'schedulable_student') { #next; @@ -481,43 +702,406 @@ sub show_table { my $ids; foreach my $entry (sort(keys(%consumed))) { my (undef,$id)=split("\0",$entry); - $ids.= $id.'-> '.$consumed{$entry}->{'name'}.'
'; + my ($uname,$udom) = split('@',$consumed{$entry}{'name'}); + my $name = &Apache::loncommon::plainname($uname,$udom); + $ids.= ''.$name.&remove_link($slot,$entry,$uname,$udom, + $consumed{$entry}{'symb'}) + .'
'; } - my $start=localtime($slots{$slot}->{'starttime'}); - my $end=localtime($slots{$slot}->{'endtime'}); - $r->print(<{'starttime'}? + &Apache::lonlocal::locallocaltime($slots{$slot}->{'starttime'}):''); + my $end=($slots{$slot}->{'endtime'}? + &Apache::lonlocal::locallocaltime($slots{$slot}->{'endtime'}):''); + my $start_reserve=($slots{$slot}->{'startreserve'}? + &Apache::lonlocal::locallocaltime($slots{$slot}->{'startreserve'}):''); + + my $unique; + if (ref($slots{$slot}{'uniqueperiod'})) { + $unique=localtime($slots{$slot}{'uniqueperiod'}[0]).','. + localtime($slots{$slot}{'uniqueperiod'}[1]); + } + + my $title; + if (exists($slots{$slot}{'symb'})) { + my (undef,undef,$res)= + &Apache::lonnet::decode_symb($slots{$slot}{'symb'}); + $res = &Apache::lonnet::clutter($res); + $title = &Apache::lonnet::gettitle($slots{$slot}{'symb'}); + $title=''.$title.''; + } + + my @proctors; + my $rowspan=1; + my $colspan=1; + if (exists($show{'proctor'})) { + $rowspan=2; + @proctors= map { + my ($uname,$udom)=split(/@/,$_); + my $fullname=$name_cache{$_}; + if (!defined($fullname)) { + &Apache::lonnet::logthis("Gettign $uname $udom"); + $fullname = &Apache::loncommon::plainname($uname,$udom); + $fullname =~s/\s/ /g; + $name_cache{$_} = $fullname; + } + &Apache::loncommon::aboutmewrapper($fullname,$uname,$udom); + } (sort(split(/\s*,\s*/,$slots{$slot}->{'proctor'}))); + } + my $proctors=join(', ',@proctors); + + my $edit=(<<"EDITLINK"); +Edit +EDITLINK + + my $delete=(<<"DELETELINK"); +Delete +DELETELINK + if ($ids ne '') { undef($delete); } + + $r->print("\n$edit $delete\n"); + if (exists($show{'name'})) { + $colspan++;$r->print("$slot"); + } + if (exists($show{'description'})) { + $colspan++;$r->print("$description\n"); + } + if (exists($show{'type'})) { + $colspan++;$r->print("$slots{$slot}->{'type'}\n"); + } + if (exists($show{'starttime'})) { + $colspan++;$r->print("$start\n"); + } + if (exists($show{'endtime'})) { + $colspan++;$r->print("$end\n"); + } + if (exists($show{'startreserve'})) { + $colspan++;$r->print("$start_reserve\n"); + } + if (exists($show{'secret'})) { + $colspan++;$r->print("$slots{$slot}{'secret'}\n"); + } + if (exists($show{'maxspace'})) { + $colspan++;$r->print("$slots{$slot}{'maxspace'}\n"); + } + if (exists($show{'ip'})) { + $colspan++;$r->print("$slots{$slot}{'ip'}\n"); + } + if (exists($show{'symb'})) { + $colspan++;$r->print("$title\n"); + } + if (exists($show{'uniqueperiod'})) { + $colspan++;$r->print("$unique\n"); + } + $colspan++;$r->print("$ids\n\n"); + if (exists($show{'proctor'})) { + $r->print(< - $slot - $slots{$slot}->{'type'} - $description - $start - $end - $slots{$slot}->{'maxspace'} - $ids - $slots{$slot}->{'proctor'} - $slots{$slot}->{'uniqueperiod'} + $proctors STUFF + } } $r->print(''); } +sub upload_start { + my ($r)=@_; + $r->print(&Apache::grades::checkforfile_js()); + my $result.=''."\n"; + $result.='
'."\n"; + $result.=' '. + &mt('Specify a file containing the slot definitions.'). + '
'."\n"; + my $upfile_select=&Apache::loncommon::upfile_select_html(); + my $ignore=&mt('Ignore First Line'); + $result.=< + +$upfile_select +
+ + +ENDUPFORM + $result.='
'."\n"; + $result.=''."\n"; + $r->print($result); +} + +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'); + $r->print(< +

Identify fields

+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) =@_; + $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'], + ['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']); +} + +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('

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"); + } + if ($entries{$fields{'startreserve'}}) { + $slot{'startreserve'}= + &UnixDate($entries{$fields{'startreserve'}},"%s"); + } + 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; + } + + &Apache::lonnet::cput('slots',{$name=>\%slot},$cdom,$cname); + $r->print('.'); + $r->rflush(); + $countdone++; + } + $r->print("

Created $countdone slots\n

"); + foreach my $error (@errors) { + $r->print("

$error\n

"); + } + &show_table($r,$mgr); + return ''; +} + sub handler { my $r=shift; - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); - &start_page($r); - my $symb=&Apache::lonnet::unescape($env{'form.symb'}); - my (undef,undef,$res)=&Apache::lonnet::decode_symb($symb); - if ($res !~ /\.task$/) { - &fail($r,'not_valid'); + &Apache::loncommon::content_type($r,'text/html'); + &Apache::loncommon::no_cache($r); + if ($r->header_only()) { + $r->send_http_header(); return OK; } - $env{'request.symb'}=$symb; + + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); + my $vgr=&Apache::lonnet::allowed('vgr',$env{'request.course.id'}); + my $mgr=&Apache::lonnet::allowed('mgr',$env{'request.course.id'}); + my $title='Requesting Another Worktime'; + if ($env{'form.command'} =~ /^(showslots|uploadstart|csvuploadmap|csvuploadassign)$/ && $vgr eq 'F') { + $title = 'Managing Slots'; + } + &start_page($r,$title); + if ($env{'form.command'} eq 'showslots' && $vgr eq 'F') { - &show_table($r,$symb); + &show_table($r,$mgr); + } elsif ($env{'form.command'} eq 'remove_registration' && $mgr eq 'F') { + &remove_registration($r); + } elsif ($env{'form.command'} eq 'release' && $mgr eq 'F') { + &release_slot($r,undef,undef,undef,$mgr); + } elsif ($env{'form.command'} eq 'delete' && $mgr eq 'F') { + &delete_slot($r); + } elsif ($env{'form.command'} eq 'uploadstart' && $mgr eq 'F') { + &upload_start($r); + } elsif ($env{'form.command'} eq 'csvuploadmap' && $mgr eq 'F') { + &csv_upload_map($r); + } elsif ($env{'form.command'} eq 'csvuploadassign' && $mgr eq 'F') { + if ($env{'form.associate'} ne 'Reverse Association') { + &csv_upload_assign($r,$mgr); + } else { + if ( $env{'form.upfile_associate'} ne 'reverse' ) { + $env{'form.upfile_associate'} = 'reverse'; + } else { + $env{'form.upfile_associate'} = 'forward'; + } + &csv_upload_map($r); + } } else { + my $symb=&Apache::lonnet::unescape($env{'form.symb'}); + my (undef,undef,$res)=&Apache::lonnet::decode_symb($symb); + if ($res !~ /\.task$/) { + &fail($r,'not_valid'); + return OK; + } + $env{'request.symb'}=$symb; my ($status) = &Apache::lonhomework::check_task_access('0'); if ($status eq 'CAN_ANSWER' || $status eq 'NEEDS_CHECKIN' || 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.