loncom/interface/groupsort.pm - view

File: [LON-CAPA] / loncom / interface / groupsort.pm
Revision 1.27: download - view: text, annotated - select for diffs
Mon May 10 08:34:50 2004 UTC (20 years, 1 month ago) by taceyjo1
Branches: MAIN
CVS tags: HEAD

Here is the fix for bug 2884 that is better and fixes the problem
without slowing everything down, leaving the 1.101 in there as it
seems
to be good.  If these changes seem to open up some type of blackhole
of
some sort or anything else that is no good, just let me know.

Teaches groupsort about metadata to sort it's self out.  Tested and
works ok.

1: # The LearningOnline Network with CAPA 2: # The LON-CAPA group sort handler 3: # Allows for sorting prior to import into RAT. 4: # 5: # $Id: groupsort.pm,v 1.27 2004/05/10 08:34:50 taceyjo1 Exp $ 6: # 7: # Copyright Michigan State University Board of Trustees 8: # 9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 10: # 11: # LON-CAPA is free software; you can redistribute it and/or modify 12: # it under the terms of the GNU General Public License as published by 13: # the Free Software Foundation; either version 2 of the License, or 14: # (at your option) any later version. 15: # 16: # LON-CAPA is distributed in the hope that it will be useful, 17: # but WITHOUT ANY WARRANTY; without even the implied warranty of 18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19: # GNU General Public License for more details. 20: # 21: # You should have received a copy of the GNU General Public License 22: # along with LON-CAPA; if not, write to the Free Software 23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 24: # 25: # /home/httpd/html/adm/gpl.txt 26: # 27: # http://www.lon-capa.org/ 28: # 29: # YEAR=2001 30: # YEAR=2002 31: # 32: ### 33: 34: package Apache::groupsort; 35: 36: use strict; 37: 38: use Apache::Constants qw(:common); 39: use GDBM_File; 40: use Apache::loncommon; 41: use Apache::lonlocal; 42: use Apache::lonnet; 43: 44: my %hash; # variable to tie to user specific database 45: my $iconpath; # variable to be accessible to multiple subroutines 46: 47: sub cleanup { 48: if (tied(%hash)){ 49: &Apache::lonnet::logthis('Cleanup groupsort: hash'); 50: unless (untie(%hash)) { 51: &Apache::lonnet::logthis('Failed cleanup groupsort: hash'); 52: } 53: } 54: } 55: 56: # ---------------------------------------------------------------- Main Handler 57: sub handler { 58: my $r = shift; 59: 60: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 61: ['acts','catalogmode','mode']); 62: # color scheme 63: my $fileclr = '#ffffe6'; 64: my $titleclr = '#ddffff'; 65: 66: &Apache::loncommon::content_type($r,'text/html'); 67: $r->send_http_header; 68: return OK if $r->header_only; 69: 70: # finish_import looks different for graphical or "simple" RAT 71: my $finishimport=''; 72: if ($ENV{'form.mode'} eq 'simple' || $ENV{'form.mode'} eq '') { 73: $finishimport=(<<ENDSMP); 74: function finish_import() { 75: opener.document.forms.simpleedit.importdetail.value=''; 76: for (var num=0; num<document.forms.groupsort.fnum.value; num++) { 77: opener.document.forms.simpleedit.importdetail.value+='&'+ 78: escape(eval("document.forms.groupsort.title"+num+".value"))+'='+ 79: escape(eval("document.forms.groupsort.filelink"+num+".value")); 80: } 81: opener.document.forms.simpleedit.submit(); 82: self.close(); 83: } 84: ENDSMP 85: } else { 86: $finishimport=(<<ENDADV); 87: function finish_import() { 88: var linkflag=false; 89: for (var num=0; num<document.forms.groupsort.fnum.value; num++) { 90: insertRowInLastRow(); 91: placeResourceInLastRow( 92: eval("document.forms.groupsort.title"+num+".value"), 93: eval("document.forms.groupsort.filelink"+num+".value"), 94: linkflag 95: ); 96: linkflag=true; 97: } 98: opener.editmode=0; 99: opener.notclear=0; 100: opener.linkmode=0; 101: opener.draw(); 102: self.close(); 103: } 104: ENDADV 105: } 106: 107: # output start of web page 108: 109: $r->print(<<END); 110: <html> 111: <head> 112: <title>The LearningOnline Network With CAPA Group Sorter</title> 113: <script language='javascript'> 114: function insertRowInLastRow() { 115: opener.insertrow(opener.maxrow); 116: opener.addobj(opener.maxrow,'e&2'); 117: } 118: function placeResourceInLastRow (title,url,linkflag) { 119: opener.newresource(opener.maxrow,2,opener.escape(title), 120: opener.escape(url),'false','normal'); 121: opener.save(); 122: opener.mostrecent=opener.obj.length-1; 123: if (linkflag) { 124: opener.joinres(opener.linkmode,opener.mostrecent,0); 125: } 126: opener.linkmode=opener.mostrecent; 127: } 128: $finishimport 129: function selectchange(val) { 130: var newval=0+eval("document.forms.groupsort.alt"+val+".selectedIndex"); 131: orderchange(val,newval); 132: } 133: function move(val,newval) { 134: orderchange(val,newval); 135: } 136: function orderchange(val,newval) { 137: document.forms.groupsort.oldval.value=val; 138: document.forms.groupsort.newval.value=newval; 139: document.forms.groupsort.submit(); 140: } 141: </script> 142: </head> 143: END 144: # read pertinent machine configuration 145: my $domain = $r->dir_config('lonDefDomain'); 146: $iconpath = $r->dir_config('lonIconsURL') . "/"; 147: 148: my %shash; # sort order (key is resource location, value is sort order) 149: my %thash; # title (key is resource location, value is title) 150: 151: my $diropendb; 152: # ------------------------------ which file do we open? Easy if explictly given 153: if ($ENV{'form.catalogmode'} eq 'groupsearch') { 154: $diropendb = 155: "/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_searchcat.db"; 156: } 157: elsif ($ENV{'form.catalogmode'} eq 'groupimport') { 158: $diropendb = 159: "/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_indexer.db"; 160: } 161: elsif ($ENV{'form.catalogmode'} eq 'groupsec') { 162: $diropendb = 163: "/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_groupsec.db"; 164: } 165: # --------------------- not explicitly given, choose the one most recently used 166: else { # choose last accessed 167: my @dbfn; 168: my @dbst; 169: 170: $dbfn[0] = 171: "/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_searchcat.db"; 172: $dbst[0]=-1; 173: if (-e $dbfn[0]) { 174: $dbst[0]=(stat($dbfn[0]))[9]; 175: } 176: $dbfn[1] = 177: "/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_indexer.db"; 178: $dbst[1]=-1; 179: if (-e $dbfn[1]) { 180: $dbst[1]=(stat($dbfn[1]))[9]; 181: } 182: $dbfn[2] = 183: "/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_groupsec.db"; 184: $dbst[2]=-1; 185: if (-e $dbfn[2]) { 186: $dbst[2]=(stat($dbfn[2]))[9]; 187: } 188: # Expand here for more modes 189: # .... 190: 191: # Okay, find most recent existing 192: 193: my $newest=0; 194: $diropendb=''; 195: for (my $i=0; $i<=$#dbfn; $i++) { 196: if ($dbst[$i]>$newest) { 197: $newest=$dbst[$i]; 198: $diropendb=$dbfn[$i]; 199: } 200: } 201: 202: } 203: # ----------------------------- diropendb is now the filename of the db to open 204: if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT(),0640)) { 205: my $acts = $ENV{'form.acts'}; 206: my @Acts = split(/b/,$acts); 207: my %ahash; 208: my %achash; 209: my $ac = 0; 210: foreach (@Acts) { 211: my ($state,$ref) = split(/a/); 212: $ahash{$ref} = $state; 213: $achash{$ref} = $ac; 214: $ac++; 215: } 216: foreach (sort {$achash{$a} <=> $achash{$b}} (keys %ahash)) { 217: my $key = $_; 218: if ($ahash{$key} eq '1') { 219: # my $keyz=join("<br />",keys %hash); 220: # print "<br />$key<br />$keyz".$hash{'pre_'.$key.'_link'}."<br />\n"; 221: $hash{'store_'.$hash{'pre_'.$key.'_link'}} = 222: $hash{'pre_'.$key.'_title'}; 223: $hash{'storectr_'.$hash{'pre_'.$key.'_link'}} = 224: $hash{'storectr'}+0; 225: $hash{'storectr'}++; 226: } 227: if ($ahash{$key} eq '0') { 228: if ($hash{'store_'.$hash{'pre_'.$key.'_link'}}) { 229: delete $hash{'store_'.$hash{'pre_'.$key.'_link'}}; 230: } 231: } 232: } 233: foreach (keys %hash) { 234: if ($_ =~ /^store_/) { 235: my $key = $_; 236: $key =~ s/^store_//; 237: $shash{$key} = $hash{'storectr_'.$key}; 238: if (&Apache::lonnet::gettitle($key) eq '') { 239: $thash{$key} = $hash{'store_'.$key}; } 240: else { 241: $thash{$key} = &Apache::lonnet::gettitle($key); } 242: } 243: } 244: if ($ENV{'form.oldval'}) { 245: my $newctr = 0; 246: my %chash; 247: foreach (sort {$shash{$a} <=> $shash{$b}} (keys %shash)) { 248: my $key = $_; 249: $newctr++; 250: $shash{$key} = $newctr; 251: $hash{'storectr_'.$key} = $newctr; 252: $chash{$newctr} = $key; 253: } 254: my $oldval = $ENV{'form.oldval'}; 255: my $newval = $ENV{'form.newval'}; 256: if ($oldval != $newval) { 257: # when newval==0, then push down and delete 258: if ($newval!=0) { 259: $shash{$chash{$oldval}} = $newval; 260: $hash{'storectr_'.$chash{$oldval}} = $newval; 261: } 262: else { 263: $shash{$chash{$oldval}} = $newctr; 264: $hash{'storectr_'.$chash{$oldval}} = $newctr; 265: } 266: if ($newval==0) { # push down 267: my $newval2=$newctr; 268: for my $idx ($oldval..($newval2-1)) { 269: $shash{$chash{$idx+1}} = $idx; 270: $hash{'storectr_'.$chash{$idx+1}} = $idx; 271: } 272: delete $shash{$chash{$oldval}}; 273: delete $hash{'storectr_'.$chash{$oldval}}; 274: delete $hash{'store_'.$chash{$oldval}}; 275: } 276: elsif ($oldval < $newval) { # push down 277: for my $idx ($oldval..($newval-1)) { 278: $shash{$chash{$idx+1}} = $idx; 279: $hash{'storectr_'.$chash{$idx+1}} = $idx; 280: } 281: } 282: elsif ($oldval > $newval) { # push up 283: for my $idx (reverse($newval..($oldval-1))) { 284: $shash{$chash{$idx}} = $idx+1; 285: $hash{'storectr_'.$chash{$idx}} = $idx+1; 286: } 287: } 288: } 289: } 290: } else { 291: $r->print('Unable to tie hash to db file</body></html>'); 292: return OK; 293: } 294: untie %hash; 295: my $ctr = 0; 296: my $clen = scalar(keys %shash); 297: if ($clen > 1) { 298: my %lt=&Apache::lonlocal::texthash( 299: 'fin'=> 'Finalize order of resources', 300: 'gb' => 'Go Back', 301: 'ns' => 'New Search', 302: 'fi' => 'Finish Import', 303: 'ca' => 'Cancel', 304: 'co' => 'Change Order', 305: 'ti' => 'Title', 306: 'pa' => 'Path' 307: ); 308: $r->print(&Apache::loncommon::bodytag('Sort Imported Resources')); 309: $r->print(<<END); 310: <b><font color="#888888">$lt{'fin'}</font></b> 311: <form method='post' action='/adm/groupsort' name='groupsort' 312: enctype='application/x-www-form-urlencoded'> 313: <input type="hidden" name="fnum" value="$clen" /> 314: <input type="hidden" name="oldval" value="" /> 315: <input type="hidden" name="newval" value="" /> 316: <input type="hidden" name="mode" value="$ENV{'form.mode'}" /> 317: END 318: 319: # --- Expand here if "GO BACK" button desired 320: if ($ENV{'form.catalogmode'} eq 'groupimport') { 321: $r->print(<<END); 322: <input type="button" name="alter" value="$lt{'gb'}" 323: onClick="window.location='/res/?catalogmode=groupimport'" />  324: END 325: } 326: if ($ENV{'form.catalogmode'} eq 'groupsearch') { 327: $r->print(<<END); 328: <input type="button" name="alter" value="$lt{'ns'}" 329: onClick="window.location='/adm/searchcat?catalogmode=groupsearch&cleargroupsort=1'" />  330: END 331: } 332: # --- 333: 334: $r->print(<<END); 335: <input type="button" name="alter" value="$lt{'fi'}" 336: onClick="finish_import()" />  337: <input type="button" name="alter" value="$lt{'ca'}" onClick="self.close()" /> 338: END 339: $r->print("<table border='0'><tr><td bgcolor='#eeeeee'>"); 340: $r->print("<table border=0><tr>\n"); 341: $r->print("<td colspan='2' bgcolor='$titleclr'><b>$lt{'co'}</b></td>\n"); 342: $r->print("<td colspan='2' bgcolor='$titleclr'><b>$lt{'ti'}</b></td>\n"); 343: $r->print("<td bgcolor='$titleclr'><b>$lt{'pa'}</b></td></tr>\n"); 344: } else { 345: $r->print(<<END); 346: <body> 347: <form method='post' action='/adm/groupsort' name='groupsort' 348: enctype='application/x-www-form-urlencoded'> 349: <input type="hidden" name="fnum" value="$clen" /> 350: <input type="hidden" name="oldval" value="" /> 351: <input type="hidden" name="newval" value="" /> 352: <input type="hidden" name="mode" value="$ENV{'form.mode'}" /> 353: END 354: } 355: foreach (sort {$shash{$a}<=>$shash{$b}} (keys %shash)) { 356: my $key=$_; 357: $ctr++; 358: my $iconname=&Apache::loncommon::icon($key); 359: if ($clen > 1) { 360: $r->print("<tr><td bgcolor='$fileclr'>"); 361: $r->print(&movers($clen,$ctr)); 362: } 363: $r->print(&hidden($ctr-1,$thash{$key},$key)); 364: if ($clen > 1) { 365: $r->print("</td><td bgcolor='$fileclr'>"); 366: $r->print(&select_box($clen,$ctr)); 367: $r->print("</td><td bgcolor='$fileclr'>"); 368: $r->print("<img src='$iconname' />"); 369: $r->print("</td><td bgcolor='$fileclr'>"); 370: $r->print("$thash{$key}</td><td bgcolor='$fileclr'>\n"); 371: $r->print("$key</td></tr>\n"); 372: } 373: } 374: if ($clen > 1) { 375: $r->print("</table></td></tr></table></form>"); 376: } else { 377: $r->print(<<END); 378: <script type="text/javascript"> 379: finish_import(); 380: </script> 381: END 382: } 383: $r->print(<<END); 384: </body> 385: </html> 386: END 387: 388: return OK; 389: } 390: 391: # --------------------------------------- Hidden values (returns scalar string) 392: sub hidden { 393: my ($sel,$title,$filelink) = @_; 394: my $string = '<input type="hidden" name="title'.$sel.'" value="'.$title. 395: '" />'; 396: $string .= '<input type="hidden" name="filelink'.$sel.'" value="'. 397: $filelink.'" />'; 398: return $string; 399: } 400: 401: # --------------------------------------- Moving arrows (returns scalar string) 402: sub movers { 403: my ($total,$sel) = @_; 404: my $dsel = $sel-1; 405: my $usel = $sel+1; 406: $usel = 1 if $usel > $total; 407: $dsel = $total if $dsel < 1; 408: my $string; 409: $string = (<<END); 410: <table border='0' cellspacing='0' cellpadding='0'> 411: <tr><td><a href='javascript:move($sel,$dsel)'> 412: <img src="${iconpath}move_up.gif" alt='UP' border='0' /></a></td></tr> 413: <tr><td><a href='javascript:move($sel,$usel)'> 414: <img src="${iconpath}move_down.gif" alt='DOWN' border='0' /></a></td></tr> 415: </table> 416: END 417: return $string; 418: } 419: 420: # ------------------------------------------ Select box (returns scalar string) 421: sub select_box { 422: my ($total,$sel) = @_; 423: my $string; 424: $string = '<select name="alt'.$sel.'"'; 425: $string .= " onChange='selectchange($sel)'>"; 426: $string .= "<option name='o0' value='0'>remove</option>"; 427: for my $cur (1..$total) { 428: $string .= "<option name='o$cur' value='$cur'"; 429: if ($cur == $sel) { 430: $string .= "selected"; 431: } 432: $string .= ">$cur</option>"; 433: } 434: $string .= "</select>\n"; 435: return $string; 436: } 437: 438: 1; 439: 440: __END__