--- loncom/interface/groupsort.pm 2002/08/16 17:03:23 1.14 +++ loncom/interface/groupsort.pm 2006/06/08 13:56:31 1.43 @@ -2,7 +2,7 @@ # The LON-CAPA group sort handler # Allows for sorting prior to import into RAT. # -# $Id: groupsort.pm,v 1.14 2002/08/16 17:03:23 matthew Exp $ +# $Id: groupsort.pm,v 1.43 2006/06/08 13:56:31 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,11 +26,6 @@ # # 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; @@ -39,34 +34,195 @@ use strict; use Apache::Constants qw(:common); use GDBM_File; +use Apache::loncommon; +use Apache::lonlocal; +use Apache::lonnet; -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 readfromdb { + my ($r,$shash,$thash)=@_; + + my $diropendb = + "/home/httpd/perl/tmp/$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)) { + 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') { + $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}; + if (&Apache::lonnet::gettitle($key) eq '') { + $$thash{$key} = $hash{'store_'.$key}; + } else { + $$thash{$key} = &Apache::lonnet::gettitle($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; + } + } + } + } + } else { + $r->print('Unable to tie hash to db file'); + } + untie %hash; + return ($shash,$thash); +} + + + +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,$shash,$thash,$nhash)=@_; + 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; + my $n=1; + 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; } + } else { + if ($token->[2]->{'type'} eq 'zombie') { next; } + } + + my $url=$token->[2]->{'src'}; + my $name=$token->[2]->{'title'}; + $name=~s/ \[\((\d+)\,(\w+)\,(\w+)\)\]$//; + if ($1) { + $$nhash{$url}='
'.&mt('Removed by '). + &Apache::loncommon::plainname($2,$3).', '. + &Apache::lonlocal::locallocaltime($1); + } + $name=~s/\&colon\;/\:/g; + $$thash{$url}=$name; + $$shash{$url}=$n; + $n++; + } + } + } + } + return ($shash,$thash); +} # ---------------------------------------------------------------- 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; # finish_import looks different for graphical or "simple" RAT my $finishimport=''; - if ($ENV{'form.mode'} eq 'simple') { + my $begincondition=''; + my $endcondition=''; + if ($env{'form.readfile'}) { + $begincondition='if (eval("document.forms.groupsort.include"+num+".checked")) {'; + $endcondition='}'; + } + if ($env{'form.mode'} eq 'simple' || $env{'form.mode'} eq '') { $finishimport=(< + my $js = < function insertRowInLastRow() { opener.insertrow(opener.maxrow); opener.addobj(opener.maxrow,'e&2'); } function placeResourceInLastRow (title,url,linkflag) { - opener.newresource(opener.maxrow,2,opener.escape(title), + opener.mostrecent=opener.newresource(opener.maxrow,2,opener.escape(title), opener.escape(url),'false','normal'); opener.save(); - opener.mostrecent=opener.obj.length-1; if (linkflag) { opener.joinres(opener.linkmode,opener.mostrecent,0); } @@ -129,220 +282,124 @@ function orderchange(val,newval) { document.forms.groupsort.submit(); } - - 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 %nhash; # notes (key is resource location); - my $diropendb; -# ------------------------------ which file do we open? Easy if explictly given - 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"; - } - elsif ($ENV{'form.catalogmode'} eq 'groupsec') { - $diropendb = - "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_groupsec.db"; - } -# --------------------- not explicitly given, choose the one most recently used - else { # choose last accessed - my @dbfn; - my @dbst; - - $dbfn[0] = - "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db"; - $dbst[0]=-1; - if (-e $dbfn[0]) { - $dbst[0]=(stat($dbfn[0]))[9]; - } - $dbfn[1] = - "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db"; - $dbst[1]=-1; - if (-e $dbfn[1]) { - $dbst[1]=(stat($dbfn[1]))[9]; - } - $dbfn[2] = - "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_groupsec.db"; - $dbst[2]=-1; - if (-e $dbfn[2]) { - $dbst[2]=(stat($dbfn[2]))[9]; - } -# Expand here for more modes -# .... - -# Okay, find most recent existing - - my $newest=0; - $diropendb=''; - for (my $i=0; $i<=$#dbfn; $i++) { - if ($dbst[$i]>$newest) { - $newest=$dbst[$i]; - $diropendb=$dbfn[$i]; - } - } - - } -# ----------------------------- diropendb is now the filename of the db to open - 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,\%shash,\%thash,\%nhash); } else { - $r->print('Unable to tie hash to db file'); - return OK; + &readfromdb($r,\%shash,\%thash); } - untie %hash; + my $ctr = 0; my $clen = scalar(keys %shash); - $r->print(< - The LearningOnline Network With CAPA Group Sorter - -Finalize order of resources + if (($clen > 1) || ($env{'form.readfile'})) { + my %lt=&Apache::lonlocal::texthash( + 'fin'=> 'Finalize order of resources', + 'ci' => 'Continue Import', + 'cs' => 'Continue Search', + 'fi' => 'Finish Import', + 'ca' => 'Cancel', + 'co' => 'Change Order', + 'ti' => 'Title', + 'pa' => 'Path', + 'in' => 'Include' + ); + $r->print(&Apache::loncommon::start_page('Sort Imported Resources', + $js)); + $r->print(<$lt{'fin'}
- + + + END -# --- Expand here if "GO BACK" button desired - if ($ENV{'form.catalogmode'} eq 'groupimport') { - $r->print(<  -END - } - if ($ENV{'form.catalogmode'} eq 'groupsearch') { - $r->print(<  + # --- Continue Buttons + my $resurl = &Apache::loncommon::lastresurl(); + $r->print(<  +  END -} -# --- + # --- - $r->print(<print(<  - + END - $r->print(""); + unless ($env{'form.readfile'}) { + $r->print(""); + } + $r->print("\n"); + } + } + if (($clen > 1) || ($env{'form.readfile'})) { + $r->print("
"); - $r->print("\n"); - $r->print("". - "\n"); - $r->print("\n"); - $r->print("\n"); + $r->print("
Change orderTitlePath
"); + $r->print("\n"); + if ($env{'form.readfile'}) { + $r->print("\n"); + } else { + $r->print("\n"); + } + $r->print("\n"); + $r->print("\n"); + } else { + $r->print(&Apache::loncommon::start_page(undef,$js, + {'only_body' => 1})); + $r->print(< + + + + +END + } foreach (sort {$shash{$a}<=>$shash{$b}} (keys %shash)) { my $key=$_; $ctr++; - my @file_ext = split(/\./,$key); - my $curfext = $file_ext[scalar(@file_ext)-1]; - $r->print("\n"); - } - $r->print("
$lt{'in'}$lt{'co'}$lt{'ti'}$lt{'pa'}
"); - $r->print(&movers($clen,$ctr)); + my $iconname=&Apache::loncommon::icon($key); + if (($clen > 1) || ($env{'form.readfile'})) { + $r->print("
"); + if ($env{'form.readfile'}) { + $r->print(&checkbox($ctr-1)); + } else { + $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(< - + if (($clen > 1) || ($env{'form.readfile'})) { + $r->print("
". + &select_box($clen,$ctr). + ""); + $r->print(""); + $r->print(""); + $r->print("$thash{$key}$nhash{$key}\n"); + $r->print("$key
"); + } else { + $r->print(< + finish_import(); + END + } + + $r->print(&Apache::loncommon::end_page()); + return OK; } @@ -381,7 +438,7 @@ sub select_box { my $string; $string = ''.&mt('Include').''; +} + 1; __END__ 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.