File:  [LON-CAPA] / loncom / interface / groupsort.pm
Revision 1.3: download - view: text, annotated - select for diffs
Tue Oct 16 17:07:25 2001 UTC (22 years, 8 months ago) by harris41
Branches: MAIN
CVS tags: stable_2001_fall, HEAD
adding in delete feature, processing catalogmode variable, restricting
interaction with _indexer.db to be just for the output

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

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