Annotation of loncom/interface/groupsort.pm, revision 1.5

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

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