File:  [LON-CAPA] / loncom / interface / groupsort.pm
Revision 1.9: download - view: text, annotated - select for diffs
Thu May 9 23:07:36 2002 UTC (22 years ago) by www
Branches: MAIN
CVS tags: HEAD
Also import GET-provided mode and use new routine for that

    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.9 2002/05/09 23:07:36 www 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: # 8/7,8/8,10/14,10/15,12/10 Scott Harrison
   31: # YEAR=2002
   32: # 1/17 Scott Harrison
   33: #
   34: ###
   35: 
   36: package Apache::groupsort;
   37: 
   38: use strict;
   39: 
   40: use Apache::Constants qw(:common);
   41: use GDBM_File;
   42: 
   43: my %hash; # variable to tie to user specific database
   44: my $iconpath; # variable to be accessible to multiple subroutines
   45: 
   46: # ---------------------------------------------------------------- Main Handler
   47: sub handler {
   48:     my $r = shift;
   49:  
   50:    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
   51:                                            ['acts','catalogmode','mode']);
   52: 
   53:     # color scheme
   54:     my $fileclr = '#ffffe6';
   55:     my $titleclr = '#ddffff';
   56: 
   57:     $r->content_type('text/html');
   58:     $r->send_http_header;
   59:     return OK if $r->header_only;
   60: 
   61: # finish_import looks different for graphical or "simple" RAT
   62:     my $finishimport='';
   63:     if ($ENV{'form.mode'} eq 'simple') {
   64:         $finishimport=(<<ENDSMP);
   65: function finish_import() {
   66:     alert("Finishing a simple import");
   67: }
   68: ENDSMP
   69:     } else {
   70:         $finishimport=(<<ENDADV);
   71: function finish_import() {
   72:     var linkflag=false;
   73:     for (var num=0; num<document.forms.groupsort.fnum.value; num++) {
   74: 	insertRowInLastRow();
   75: 	placeResourceInLastRow(
   76: 	       eval("document.forms.groupsort.title"+num+".value"),
   77:  	       eval("document.forms.groupsort.filelink"+num+".value"),
   78: 	       linkflag
   79: 	);
   80:         linkflag=true;
   81:     }
   82:     opener.editmode=0;
   83:     opener.notclear=0;
   84:     opener.linkmode=0;
   85:     opener.draw();
   86:     self.close();
   87: }
   88: ENDADV
   89:     }
   90: 
   91: # output start of web page
   92: 
   93:     $r->print(<<END);
   94: <html>
   95: <head>
   96: <title>The LearningOnline Network With CAPA Group Sorter</title>
   97: <script language='javascript'>
   98: function insertRowInLastRow() {
   99:     opener.insertrow(opener.maxrow);
  100:     opener.addobj(opener.maxrow,'e&2');
  101: }
  102: function placeResourceInLastRow (title,url,linkflag) {
  103:     opener.newresource(opener.maxrow,2,opener.escape(title),
  104: 		       opener.escape(url),'false','normal');
  105:     opener.save();
  106:     opener.mostrecent=opener.obj.length-1;
  107:     if (linkflag) {
  108: 	opener.joinres(opener.linkmode,opener.mostrecent,0);
  109:     }
  110:     opener.linkmode=opener.mostrecent;
  111: }
  112: $finishimport
  113: function selectchange(val) {
  114:     var newval=0+eval("document.forms.groupsort.alt"+val+".selectedIndex");
  115:     orderchange(val,newval);
  116: }
  117: function move(val,newval) {
  118:     orderchange(val,newval);
  119: }
  120: function orderchange(val,newval) {
  121:     document.forms.groupsort.oldval.value=val;
  122:     document.forms.groupsort.newval.value=newval;
  123:     document.forms.groupsort.submit();
  124: }
  125: </script>
  126: </head>
  127: <body bgcolor="#FFFFFF">
  128: END
  129: 
  130:     # read pertinent machine configuration
  131:     my $domain  = $r->dir_config('lonDefDomain');
  132:     $iconpath = $r->dir_config('lonIconsURL') . "/";
  133: 
  134:     my %shash; # sort order (key is resource location, value is sort order)
  135:     my %thash; # title (key is resource location, value is title)
  136: 
  137:     my $diropendb;
  138:     if ($ENV{'form.catalogmode'} eq 'groupsearch') {
  139: 	$diropendb = 
  140: 	    "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db";
  141:     }
  142:     elsif ($ENV{'form.catalogmode'} eq 'groupimport') {
  143: 	$diropendb = 
  144: 	    "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db";
  145:     }
  146:     else { # choose last accessed
  147: 	my $dsearch; my $dindex;
  148: 	my $dsearcht; my $dindext;
  149: 	$dsearch =
  150: 	    "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db";
  151: 	if (-e $dsearch) {
  152: 	    $dsearcht=(stat($dsearch))[9];
  153: 	}
  154: 	$dindex =
  155:             "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db";
  156: 	if (-e $dindex) {
  157:             $dindext=(stat($dindex))[9];
  158:         }
  159: 	if (!$dsearcht and !$dindext) {
  160: 	    $diropendb='';
  161: 	}
  162:         elsif ($dsearcht>$dindext) {
  163:             $diropendb=$dsearch;
  164:         }
  165: 	else {
  166:             $diropendb=$dindex;
  167: 	}
  168:     }
  169:     if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
  170: 	my $acts = $ENV{'form.acts'};
  171: 	my @Acts = split(/b/,$acts);
  172: 	my %ahash;
  173: 	my %achash;
  174: 	my $ac = 0;
  175: 	foreach (@Acts) {
  176: 	    my ($state,$ref) = split(/a/);
  177: 	    $ahash{$ref} = $state;
  178: 	    $achash{$ref} = $ac;
  179: 	    $ac++;
  180: 	}
  181: 	foreach (sort {$achash{$a} <=> $achash{$b}} (keys %ahash)) {
  182: 	    my $key = $_;
  183: 	    if ($ahash{$key} eq '1') {
  184: #		my $keyz=join("<br />",keys %hash);
  185: #		print "<br />$key<br />$keyz".$hash{'pre_'.$key.'_link'}."<br />\n";
  186: 		$hash{'store_'.$hash{'pre_'.$key.'_link'}} =
  187: 		    $hash{'pre_'.$key.'_title'};
  188: 		$hash{'storectr_'.$hash{'pre_'.$key.'_link'}} =
  189: 		    $hash{'storectr'}+0;
  190: 		$hash{'storectr'}++;
  191: 	    }
  192: 	    if ($ahash{$key} eq '0') {
  193: 		if ($hash{'store_'.$hash{'pre_'.$key.'_link'}}) {
  194: 		    delete $hash{'store_'.$hash{'pre_'.$key.'_link'}};
  195: 		}
  196: 	    }
  197: 	}
  198: 	foreach (keys %hash) {
  199: 	    if ($_ =~ /^store_/) {
  200: 		my $key = $_;
  201: 		$key =~ s/^store_//;
  202: 		$shash{$key} = $hash{'storectr_'.$key};
  203: 		$thash{$key} = $hash{'store_'.$key};
  204: 	    }
  205: 	}
  206: 	if ($ENV{'form.oldval'}) {
  207: 	    my $newctr = 0;
  208: 	    my %chash;
  209: 	    foreach (sort {$shash{$a} <=> $shash{$b}} (keys %shash)) {
  210: 		my $key = $_;
  211: 		$newctr++;
  212: 		$shash{$key} = $newctr;
  213: 		$hash{'storectr_'.$key} = $newctr;
  214: 		$chash{$newctr} = $key;
  215: 	    }
  216: 	    my $oldval = $ENV{'form.oldval'};
  217: 	    my $newval = $ENV{'form.newval'};
  218: 	    if ($oldval != $newval) {
  219: 		# when newval==0, then push down and delete
  220: 		if ($newval!=0) {
  221: 		    $shash{$chash{$oldval}} = $newval;
  222: 		    $hash{'storectr_'.$chash{$oldval}} = $newval;
  223: 		}
  224: 		else {
  225: 		    $shash{$chash{$oldval}} = $newctr;
  226: 		    $hash{'storectr_'.$chash{$oldval}} = $newctr;
  227: 		}
  228: 		if ($newval==0) { # push down
  229: 		    my $newval2=$newctr;
  230: 		    for my $idx ($oldval..($newval2-1)) {
  231: 			$shash{$chash{$idx+1}} = $idx;
  232: 			$hash{'storectr_'.$chash{$idx+1}} = $idx;
  233: 		    }
  234: 		    delete $shash{$chash{$oldval}};
  235: 		    delete $hash{'storectr_'.$chash{$oldval}};
  236: 		    delete $hash{'store_'.$chash{$oldval}};
  237: 		}
  238: 		elsif ($oldval < $newval) { # push down
  239: 		    for my $idx ($oldval..($newval-1)) {
  240: 			$shash{$chash{$idx+1}} = $idx;
  241: 			$hash{'storectr_'.$chash{$idx+1}} = $idx;
  242: 		    }
  243: 		}
  244: 		elsif ($oldval > $newval) { # push up
  245: 		    for my $idx (reverse($newval..($oldval-1))) {
  246: 			$shash{$chash{$idx}} = $idx+1;
  247: 			$hash{'storectr_'.$chash{$idx}} = $idx+1;
  248: 		    }
  249: 		}
  250: 	    }
  251: 	}
  252:     } else {
  253: 	$r->print('Unable to tie hash to db file</body></html>');
  254: 	return OK;
  255:     }
  256:     untie %hash;
  257:     my $ctr = 0;
  258:     my $clen = scalar(keys %shash);
  259:     $r->print('<h2><font color="#888888">The LearningOnline With CAPA '.
  260: 	      'Group Sorter</font></h2>'."\n");
  261:     $r->print('<b><font color="#888888">Finalize order of resources</font>'.
  262: 	      '</b>'."\n");
  263:     $r->print("<form method='post' action='/adm/groupsort' name='groupsort' ".
  264: 	      "enctype='application/x-www-form-urlencoded'>");
  265:     $r->print(<<END);
  266: <input type="hidden" name="fnum" value="$clen" />
  267: <input type="hidden" name="oldval" value="" />
  268: <input type="hidden" name="newval" value="" />
  269: END
  270:     if ($ENV{'form.catalogmode'} eq 'groupimport') {
  271: 	$r->print(<<END);
  272: <input type="button" name="alter" value="GO BACK"
  273:  onClick="window.location='/res/?catalogmode=groupimport'" />&nbsp;
  274: END
  275:     }
  276:     if ($ENV{'form.catalogmode'} eq 'groupsearch') {
  277: 	$r->print(<<END);
  278: <input type="button" name="alter" value="GO BACK"
  279:  onClick="window.location='/adm/searchcat?catalogmode=groupsearch'" />&nbsp;
  280: END
  281: }
  282:     $r->print(<<END);
  283: <input type="button" name="alter" value="FINISH IMPORT"
  284:  onClick="finish_import()" />&nbsp;
  285: <input type="button" name="alter" value="CANCEL" onClick="self.close()" />
  286: END
  287:     $r->print("<table border='0'><tr><td bgcolor='#eeeeee'>");
  288:     $r->print("<table border=0><tr>\n");
  289:     $r->print("<td colspan='2' bgcolor='$titleclr'><b>Change order</b></td>".
  290: 	      "\n");
  291:     $r->print("<td colspan='2' bgcolor='$titleclr'><b>Title</b></td>\n");
  292:     $r->print("<td bgcolor='$titleclr'><b>Path</b></td></tr>\n");
  293:     foreach (sort {$shash{$a}<=>$shash{$b}} (keys %shash)) {
  294: 	my $key=$_;
  295: 	$ctr++;
  296: 	my @file_ext = split(/\./,$key);
  297: 	my $curfext = $file_ext[scalar(@file_ext)-1];
  298: 	$r->print("<tr><td bgcolor='$fileclr'>");
  299: 	$r->print(&movers($clen,$ctr));
  300: 	$r->print(&hidden($ctr-1,$thash{$key},$key));
  301: 	$r->print("</td><td bgcolor='$fileclr'>");
  302: 	$r->print(&select_box($clen,$ctr));
  303: 	$r->print("</td><td bgcolor='$fileclr'>");
  304: 	$r->print("<img src='$iconpath$curfext.gif'>");
  305: 	$r->print("</td><td bgcolor='$fileclr'>");
  306: 	$r->print("$thash{$key}</td><td bgcolor='$fileclr'>\n");
  307: 	$r->print("$key</td></tr>\n");
  308:     } 
  309:     $r->print("</table></td></tr></table></form>");
  310:     $r->print(<<END);
  311: </body>
  312: </html>
  313: END
  314:     return OK;
  315: }
  316: 
  317: # --------------------------------------- Hidden values (returns scalar string)
  318: sub hidden {
  319:     my ($sel,$title,$filelink) = @_;
  320:     my $string = '<input type="hidden" name="title'.$sel.'" value="'.$title.
  321: 	'" />';
  322:     $string .= '<input type="hidden" name="filelink'.$sel.'" value="'.
  323: 	$filelink.'" />';
  324:     return $string;
  325: }
  326: 
  327: # --------------------------------------- Moving arrows (returns scalar string)
  328: sub movers {
  329:     my ($total,$sel) = @_;
  330:     my $dsel = $sel-1;
  331:     my $usel = $sel+1;
  332:     $usel = 1 if $usel > $total;
  333:     $dsel = $total if $dsel < 1;
  334:     my $string;
  335:     $string = (<<END);
  336: <table border='0' cellspacing='0' cellpadding='0'>
  337: <tr><td><a href='javascript:move($sel,$dsel)'>
  338: <img src="${iconpath}move_up.gif" alt='UP' border='0' /></a></td></tr>
  339: <tr><td><a href='javascript:move($sel,$usel)'>
  340: <img src="${iconpath}move_down.gif" alt='DOWN' border='0' /></a></td></tr>
  341: </table>
  342: END
  343:     return $string;
  344: }
  345: 
  346: # ------------------------------------------ Select box (returns scalar string)
  347: sub select_box {
  348:     my ($total,$sel) = @_;
  349:     my $string;
  350:     $string = '<select name="alt'.$sel.'"';
  351:     $string .= " onChange='selectchange($sel)'>";
  352:     $string .= "<option name='o0' value='0'>remove</option>";
  353:     for my $cur (1..$total) {
  354: 	$string .= "<option name='o$cur' value='$cur'";
  355: 	if ($cur == $sel) {
  356: 	    $string .= "selected";
  357: 	}
  358: 	$string .= ">$cur</option>";
  359:     }
  360:     $string .= "</select>\n";
  361:     return $string;
  362: }
  363: 
  364: 1;
  365: 
  366: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>