--- loncom/interface/groupsort.pm 2002/05/09 23:07:36 1.9 +++ loncom/interface/groupsort.pm 2016/11/22 15:55:40 1.68.6.8 @@ -2,7 +2,7 @@ # The LON-CAPA group sort handler # Allows for sorting prior to import into RAT. # -# $Id: groupsort.pm,v 1.9 2002/05/09 23:07:36 www Exp $ +# $Id: groupsort.pm,v 1.68.6.8 2016/11/22 15:55:40 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,58 +26,293 @@ # # http://www.lon-capa.org/ # -# YEAR=2001 -# 8/7,8/8,10/14,10/15,12/10 Scott Harrison -# YEAR=2002 -# 1/17 Scott Harrison -# ### package Apache::groupsort; use strict; -use Apache::Constants qw(:common); +use Apache::Constants qw(:common :http); use GDBM_File; +use Apache::loncommon; +use Apache::lonlocal; +use Apache::lonnet; +use LONCAPA qw(:DEFAULT :match); -my %hash; # variable to tie to user specific database my $iconpath; # variable to be accessible to multiple subroutines +my %hash; # variable to tie to user specific database + + +sub update_actions_hash { + my ($hash) = @_; + # be careful in here, there is also a global %hash + my $acts=$env{'form.acts'}; + my @Acts=split(/b/,$acts); + my %ahash; + my %achash; + # some initial hashes for working with data + my $ac=0; + foreach (@Acts) { + my ($state,$ref)=split(/a/); + $ahash{$ref}=$state; + $achash{$ref}=$ac; + $ac++; + } + # sorting through the actions and changing the global database hash + foreach my $key (sort {$achash{$a}<=>$achash{$b}} (keys(%ahash))) { + if ($ahash{$key} eq '1') { + $hash->{'store_'.$hash->{'pre_'.$key.'_link'}}= + $hash->{'pre_'.$key.'_title'}; + $hash->{'storectr_'.$hash->{'pre_'.$key.'_link'}}= + $hash->{'storectr'}+0; + $hash->{'storectr'}++; + } + if ($ahash{$key} eq '0') { + if ($hash->{'store_'.$hash->{'pre_'.$key.'_link'}}) { + delete($hash->{'store_'.$hash->{'pre_'.$key.'_link'}}); + delete($hash->{'storectr_'.$hash->{'pre_'.$key.'_link'}}); + } + } + } + # deleting the previously cached listing + foreach my $key (keys(%{ $hash })) { + next if ($key !~ /^pre_(\d+)_link/); + my $which = $1; + delete($hash->{'pre_'.$which.'_title'}); + delete($hash->{'pre_'.$which.'_link'}); + } +} + +sub readfromdb { + my ($r,$resources)=@_; + + my $diropendb = LONCAPA::tempdir() . + "$env{'user.domain'}_$env{'user.name'}_sel_res.db"; + +# ----------------------------- diropendb is now the filename of the db to open + if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT(),0640)) { + &update_actions_hash(\%hash); + + my %temp_resources; + foreach my $key (keys(%hash)) { + next if ($key !~ /^store_/); + my ($url) = ($key =~ /^store_(.*)/); + $temp_resources{$hash{'storectr_'.$url}}{'url'}=$url; + $temp_resources{$hash{'storectr_'.$url}}{'title'}= + &Apache::lonnet::gettitle($url); + } + + # use the temp, since there might be gaps in the counting + foreach my $item (sort {$a <=> $b} (keys(%temp_resources))) { + push(@{ $resources },$temp_resources{$item}); + } + + if ($env{'form.oldval'}) { + my $res = splice(@{$resources},$env{'form.oldval'}-1,1); + if ($env{'form.newval'} == 0) { + # picked 'discard' + my $url = $res->{'url'}; + delete($hash{'storectr_'.$url}); + delete($hash{'store_'.$url}); + } else { + splice(@{$resources},$env{'form.newval'}-1,0,$res); + } + } + # store out new order + foreach my $which (0..$#$resources) { + my $url = $resources->[$which]{'url'}; + $hash{'storectr_'.$url} = $which; + } + } else { + $r->print('Unable to tie hash to db file'); + } + untie(%hash); +} + + + +sub cleanup { + if (tied(%hash)){ + &Apache::lonnet::logthis('Cleanup groupsort: hash'); + unless (untie(%hash)) { + &Apache::lonnet::logthis('Failed cleanup groupsort: hash'); + } + } + return OK; +} + +# -------------------------------------------------------------- Read from file + +sub readfromfile { + my ($r,$resources)=@_; + my $cont=&Apache::lonnet::getfile + (&Apache::lonnet::filelocation('',$env{'form.readfile'})); + if ($cont==-1) { + $r->print('Unable to read file: '. + &Apache::lonnet::filelocation('',$env{'form.readfile'})); + } else { + my $parser = HTML::TokeParser->new(\$cont); + my ($token,$donechk,$allmaps); + $allmaps = {}; + while ($token = $parser->get_token) { + if ($token->[0] eq 'S') { + if ($token->[1] eq 'resource') { + if ($env{'form.recover'}) { + if ($token->[2]->{'type'} ne 'zombie') { next; } + if ($token->[2]->{'src'} =~ /\.(page|sequence)$/) { + if (($env{'request.course.id'}) && + ($env{'form.readfile'} =~ m{/default(|_\d+)\.(page|sequence)$})) { + unless ($donechk) { + $allmaps = &Apache::loncommon::allmaps_incourse(); + $donechk = 1; + } + } + if ($allmaps->{$token->[2]->{'src'}}) { next; } + } + } else { + if ($token->[2]->{'type'} eq 'zombie') { next; } + } + + my $name=$token->[2]->{'title'}; + $name=~s/ \[\((\d+)\,($LONCAPA::username_re)\,($LONCAPA::domain_re)\)\]$//; + my $note; + if ($1) { + $note = '
'.&mt('Removed by '). + &Apache::loncommon::plainname($2,$3).', '. + &Apache::lonlocal::locallocaltime($1); + } + $name=~s/\&colon\;/\:/g; + push(@{$resources}, {'url' => $token->[2]->{'src'}, + 'title' => $name, + 'note' => $note, + 'id' => $token->[2]->{'id'},}); + } + } + } + } +} # ---------------------------------------------------------------- Main Handler sub handler { my $r = shift; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, - ['acts','catalogmode','mode']); + ['acts','mode','readfile','recover']); - # color scheme - my $fileclr = '#ffffe6'; - my $titleclr = '#ddffff'; - - $r->content_type('text/html'); + &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK if $r->header_only; +# permissions checking + my ($allowed,$canedit,$context,$cid); + if ($env{'form.readfile'} =~ m{^/uploaded/($match_domain)/($match_courseid)/}) { + my ($cdom,$cnum) = ($1,$2); + $cid = $cdom.'_'.$cnum; + $context = 'course'; + if ((&Apache::lonnet::allowed('mdc',$cid)) || + (&Apache::lonnet::allowed('cev',$cid))) { + $allowed = 1; + } + } elsif ($env{'form.readfile'} =~ m{^/res/}) { + $context = 'res'; + if ((&Apache::lonnet::allowed('bre',$env{'form.readfile'})) || + (&Apache::lonnet::allowed('bro',$env{'form.readfile'}))) { + $allowed = 1; + } + } elsif (($env{'form.readfile'} eq '') && ($env{'form.acts'} ne '')) { + $allowed = 1; + } + if ($allowed) { + if ($env{'form.mode'} eq 'rat') { + if (&Apache::lonnet::allowed('are',$env{'request.role.domain'})) { + $canedit = 1; + } + } elsif (($env{'form.mode'} eq 'simple') || ($env{'form.mode'} eq '')) { + if ($context eq 'course') { + if (&Apache::lonnet::allowed('mdc',$cid)) { + $canedit = 1; + } + } elsif (($env{'request.course.id'}) && + (&Apache::lonnet::allowed('mdc',$env{'request.course.id'}))) { + $canedit = 1; + } elsif (&Apache::lonnet::allowed('are',$env{'request.role.domain'})) { + $canedit = 1; + } + } + } + + unless ($allowed) { + if ($context eq 'course') { + if ($env{'request.course.id'} eq $cid) { + $env{'user.error.msg'}= + "/adm/groupsort::0:1:Course environment gone, reinitialize the course"; + } else { + $env{'user.error.msg'}= + "/adm/groupsort:bre:0:0:Cannot view folder contents"; + } + } else { + $env{'user.error.msg'}= + "/adm/groupsort:bre:0:0:Cannot view map contents"; + } + return HTTP_NOT_ACCEPTABLE; + } + # finish_import looks different for graphical or "simple" RAT my $finishimport=''; - if ($ENV{'form.mode'} eq 'simple') { - $finishimport=(<print(< - -The LearningOnline Network With CAPA Group Sorter - - - END - # read pertinent machine configuration my $domain = $r->dir_config('lonDefDomain'); $iconpath = $r->dir_config('lonIconsURL') . "/"; - my %shash; # sort order (key is resource location, value is sort order) - my %thash; # title (key is resource location, value is title) + my @resources; - my $diropendb; - if ($ENV{'form.catalogmode'} eq 'groupsearch') { - $diropendb = - "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db"; - } - elsif ($ENV{'form.catalogmode'} eq 'groupimport') { - $diropendb = - "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db"; - } - else { # choose last accessed - my $dsearch; my $dindex; - my $dsearcht; my $dindext; - $dsearch = - "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db"; - if (-e $dsearch) { - $dsearcht=(stat($dsearch))[9]; - } - $dindex = - "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db"; - if (-e $dindex) { - $dindext=(stat($dindex))[9]; - } - if (!$dsearcht and !$dindext) { - $diropendb=''; - } - elsif ($dsearcht>$dindext) { - $diropendb=$dsearch; - } - else { - $diropendb=$dindex; - } - } - if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { - my $acts = $ENV{'form.acts'}; - my @Acts = split(/b/,$acts); - my %ahash; - my %achash; - my $ac = 0; - foreach (@Acts) { - my ($state,$ref) = split(/a/); - $ahash{$ref} = $state; - $achash{$ref} = $ac; - $ac++; - } - foreach (sort {$achash{$a} <=> $achash{$b}} (keys %ahash)) { - my $key = $_; - if ($ahash{$key} eq '1') { -# my $keyz=join("
",keys %hash); -# print "
$key
$keyz".$hash{'pre_'.$key.'_link'}."
\n"; - $hash{'store_'.$hash{'pre_'.$key.'_link'}} = - $hash{'pre_'.$key.'_title'}; - $hash{'storectr_'.$hash{'pre_'.$key.'_link'}} = - $hash{'storectr'}+0; - $hash{'storectr'}++; - } - if ($ahash{$key} eq '0') { - if ($hash{'store_'.$hash{'pre_'.$key.'_link'}}) { - delete $hash{'store_'.$hash{'pre_'.$key.'_link'}}; - } - } - } - foreach (keys %hash) { - if ($_ =~ /^store_/) { - my $key = $_; - $key =~ s/^store_//; - $shash{$key} = $hash{'storectr_'.$key}; - $thash{$key} = $hash{'store_'.$key}; - } - } - if ($ENV{'form.oldval'}) { - my $newctr = 0; - my %chash; - foreach (sort {$shash{$a} <=> $shash{$b}} (keys %shash)) { - my $key = $_; - $newctr++; - $shash{$key} = $newctr; - $hash{'storectr_'.$key} = $newctr; - $chash{$newctr} = $key; - } - my $oldval = $ENV{'form.oldval'}; - my $newval = $ENV{'form.newval'}; - if ($oldval != $newval) { - # when newval==0, then push down and delete - if ($newval!=0) { - $shash{$chash{$oldval}} = $newval; - $hash{'storectr_'.$chash{$oldval}} = $newval; - } - else { - $shash{$chash{$oldval}} = $newctr; - $hash{'storectr_'.$chash{$oldval}} = $newctr; - } - if ($newval==0) { # push down - my $newval2=$newctr; - for my $idx ($oldval..($newval2-1)) { - $shash{$chash{$idx+1}} = $idx; - $hash{'storectr_'.$chash{$idx+1}} = $idx; - } - delete $shash{$chash{$oldval}}; - delete $hash{'storectr_'.$chash{$oldval}}; - delete $hash{'store_'.$chash{$oldval}}; - } - elsif ($oldval < $newval) { # push down - for my $idx ($oldval..($newval-1)) { - $shash{$chash{$idx+1}} = $idx; - $hash{'storectr_'.$chash{$idx+1}} = $idx; - } - } - elsif ($oldval > $newval) { # push up - for my $idx (reverse($newval..($oldval-1))) { - $shash{$chash{$idx}} = $idx+1; - $hash{'storectr_'.$chash{$idx}} = $idx+1; - } - } - } - } + if ($env{'form.readfile'}) { + &readfromfile($r,\@resources); } else { - $r->print('Unable to tie hash to db file'); - return OK; + &readfromdb($r,\@resources); } - untie %hash; + my $ctr = 0; - my $clen = scalar(keys %shash); - $r->print('

The LearningOnline With CAPA '. - 'Group Sorter

'."\n"); - $r->print('Finalize order of resources'. - ''."\n"); - $r->print("
"); - $r->print(< 1) || ($env{'form.readfile'})) { + my %lt=&Apache::lonlocal::texthash( + 'fin'=> 'Finalize order of resources', + 'ci' => 'Continue Import', + 'cs' => 'Continue Search', + 'fi' => 'Finish Import', + 're' => 'Recover Checked', + 'ip' => 'Import Checked', + 'ca' => 'Cancel', + 'co' => 'Change Order', + 'ti' => 'Title', + 'pa' => 'Path', + 'in' => 'Include' + ); + + $r->print(&Apache::loncommon::start_page($title, $js)); + $r->print('

'.&mt($title).'

'); + + $r->print(< + + + END - if ($ENV{'form.catalogmode'} eq 'groupimport') { - $r->print(<  + + $r->print(&Apache::loncommon::inhibit_menu_check('input')); + # --- + + my $buttontext = $lt{'re'}; + if ($env{'form.recover'}) { + $r->print(<  + END - } - if ($ENV{'form.catalogmode'} eq 'groupsearch') { - $r->print(<  + } else { + # --- Continue Buttons + my $resurl = + &Apache::loncommon::escape_single(&Apache::loncommon::lastresurl()); + $r->print(<$lt{'fin'} +
+  +  +  + +
+
END -} - $r->print(<  - + } + + # Only display header if content exists + if ($clen > 0) { + $r->print(&Apache::loncommon::start_data_table() + .&Apache::loncommon::start_data_table_header_row()); + if (($env{'form.readfile'})) { + $r->print("$lt{'in'}\n"); + } else { + $r->print(''.$lt{'co'}.''."\n"); + } + $r->print(''.$lt{'ti'}.''."\n"); + $r->print("$lt{'pa'}"); + $r->print(&Apache::loncommon::end_data_table_header_row()."\n"); + } else { + my $errtxt = ''; + if ($env{'form.recover'}) { + $errtxt = 'There are no resources to recover.'; + } else { + $errtxt = 'There are no resources to import.'; + } + $r->print('

'.&mt($errtxt).'

'); + } + } else { + $r->print(&Apache::loncommon::start_page(undef,$js, + {'only_body' => 1})); +# $r->print('

'.&mt($title).'

'); + $r->print(< + + + + END - $r->print("
"); - $r->print("\n"); - $r->print("". - "\n"); - $r->print("\n"); - $r->print("\n"); - foreach (sort {$shash{$a}<=>$shash{$b}} (keys %shash)) { - my $key=$_; + $r->print(&Apache::loncommon::inhibit_menu_check('input')); + + } + foreach my $resource (@resources) { $ctr++; - my @file_ext = split(/\./,$key); - my $curfext = $file_ext[scalar(@file_ext)-1]; - $r->print("\n"); - } - $r->print("
Change orderTitlePath
"); - $r->print(&movers($clen,$ctr)); - $r->print(&hidden($ctr-1,$thash{$key},$key)); - $r->print(""); - $r->print(&select_box($clen,$ctr)); - $r->print(""); - $r->print(""); - $r->print(""); - $r->print("$thash{$key}\n"); - $r->print("$key
"); - $r->print(< - + my $iconname=&Apache::loncommon::icon($resource->{'url'}); + if (($clen > 1) || ($env{'form.readfile'})) { + $r->print(&Apache::loncommon::start_data_table_row() + .""); + if (($env{'form.readfile'})) { + $r->print(&checkbox($ctr-1,$disabled)); + } else { + $r->print(&movers($clen,$ctr)); + } + } + $r->print(&hidden($ctr-1,$resource->{'title'},$resource->{'url'}, + $resource->{'id'})); + if (($clen > 1) || ($env{'form.readfile'})) { + $r->print(""); + unless (($env{'form.readfile'})) { + $r->print("". + &select_box($clen,$ctr,$disabled). + ""); + } + $r->print(""); + $r->print(""); + $r->print(""); + if (($env{'form.recover'}) && + ($resource->{'url'} =~ m{/uploaded/$match_domain/$match_courseid/supplemental/})) { + my $title = &Apache::loncommon::parse_supplemental_title($resource->{'title'}); + $r->print($title); + } else { + $r->print($resource->{'title'}); + } + $r->print($resource->{'notes'}."\n"); + $r->print($resource->{'url'}."" + .&Apache::loncommon::end_data_table_row() + ."\n"); + } + } + if (($clen > 1) || ($env{'form.readfile'})) { + if ($clen > 0) { + $r->print(&Apache::loncommon::end_data_table()); + } + $r->print(''); + } else { + $r->print(< + finish_import(); + END + } + + $r->print(&Apache::loncommon::end_page()); + return OK; } # --------------------------------------- Hidden values (returns scalar string) sub hidden { - my ($sel,$title,$filelink) = @_; - my $string = ''; + my ($sel,$title,$filelink,$id) = @_; + my $string = ''; + $filelink=~s|^/ext/|http://|; $string .= ''; + &escape($filelink).'" />'; + $string .= ''; return $string; } @@ -345,11 +567,11 @@ END # ------------------------------------------ Select box (returns scalar string) sub select_box { - my ($total,$sel) = @_; + my ($total,$sel,$disabled) = @_; my $string; $string = ''.&mt('Include').''; +} + 1; __END__ + +=pod + +=head1 NAME + +Apache::groupsort.pm + +=head1 SYNOPSIS + +Implements a second phase of importing +multiple resources into the RAT. Allows for +reordering the sequence of resources + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + + +=head1 NOTABLE SUBROUTINES + +=over + +=item + +=back + +=cut + 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.