[BACK]Return to groupsort.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface
File:  [LON-CAPA] / loncom / interface / groupsort.pm
Revision 1.24: download - view: text, annotated - select for diffs
Tue Oct 7 20:30:13 2003 UTC (20 years, 8 months ago) by matthew
Branches: MAIN
CVS tags: version_1_1_X, version_1_1_3, version_1_1_2, version_1_1_1, version_1_1_0, version_1_0_99_3, version_1_0_99_2, version_1_0_99_1, version_1_0_99, HEAD
Bug 2258: Advanced search could not import into docs sequences.  The problem
was that the "Advanced Search" link did not pass the 'mode' parameter along
to the advanced search page, so $ENV{'form.mode'} eq ''.  The parameter
is now passed along (lonsearchcat.pm) and groupsort.pm has been modified to
assume a 'simple' mode if the mode is not specified.  Should go in 1.0.2.
I do not want to consider how long this has been broken.

# The LearningOnline Network with CAPA
# The LON-CAPA group sort handler
# Allows for sorting prior to import into RAT.
#
# $Id: groupsort.pm,v 1.24 2003/10/07 20:30:13 matthew Exp $
# 
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# YEAR=2001
# YEAR=2002
#
###

package Apache::groupsort;

use strict;

use Apache::Constants qw(:common);
use GDBM_File;
use Apache::loncommon;
use Apache::lonlocal;

my %hash; # variable to tie to user specific database
my $iconpath; # variable to be accessible to multiple subroutines

sub cleanup {
    if (tied(%hash)){
	&Apache::lonnet::logthis('Cleanup groupsort: hash');
        unless (untie(%hash)) {
	    &Apache::lonnet::logthis('Failed cleanup groupsort: hash');
        }
    }
}

# ---------------------------------------------------------------- Main Handler
sub handler {
    my $r = shift;
 
   &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                           ['acts','catalogmode','mode']);
    # color scheme
    my $fileclr = '#ffffe6';
    my $titleclr = '#ddffff';

    &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' || $ENV{'form.mode'} eq '') {
        $finishimport=(<<ENDSMP);
function finish_import() {
    opener.document.forms.simpleedit.importdetail.value='';
    for (var num=0; num<document.forms.groupsort.fnum.value; num++) {
	opener.document.forms.simpleedit.importdetail.value+='&'+
              escape(eval("document.forms.groupsort.title"+num+".value"))+'='+
	      escape(eval("document.forms.groupsort.filelink"+num+".value"));
    }
    opener.document.forms.simpleedit.submit();
    self.close();
}
ENDSMP
    } else {
        $finishimport=(<<ENDADV);
function finish_import() {
    var linkflag=false;
    for (var num=0; num<document.forms.groupsort.fnum.value; num++) {
	insertRowInLastRow();
	placeResourceInLastRow(
	       eval("document.forms.groupsort.title"+num+".value"),
 	       eval("document.forms.groupsort.filelink"+num+".value"),
	       linkflag
	);
        linkflag=true;
    }
    opener.editmode=0;
    opener.notclear=0;
    opener.linkmode=0;
    opener.draw();
    self.close();
}
ENDADV
    }

# output start of web page

    $r->print(<<END);
<html>
<head>
<title>The LearningOnline Network With CAPA Group Sorter</title>
<script language='javascript'>
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.escape(url),'false','normal');
    opener.save();
    opener.mostrecent=opener.obj.length-1;
    if (linkflag) {
	opener.joinres(opener.linkmode,opener.mostrecent,0);
    }
    opener.linkmode=opener.mostrecent;
}
$finishimport
function selectchange(val) {
    var newval=0+eval("document.forms.groupsort.alt"+val+".selectedIndex");
    orderchange(val,newval);
}
function move(val,newval) {
    orderchange(val,newval);
}
function orderchange(val,newval) {
    document.forms.groupsort.oldval.value=val;
    document.forms.groupsort.newval.value=newval;
    document.forms.groupsort.submit();
}
</script>
</head>
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 $diropendb;
# ------------------------------ which file do we open? Easy if explictly given
    if ($ENV{'form.catalogmode'} eq 'groupsearch') {
	$diropendb = 
	    "/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_searchcat.db";
    }
    elsif ($ENV{'form.catalogmode'} eq 'groupimport') {
	$diropendb = 
	    "/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_indexer.db";
    }
    elsif ($ENV{'form.catalogmode'} eq 'groupsec') {
	$diropendb = 
	    "/home/httpd/perl/tmp/$ENV{'user.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/$ENV{'user.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/$ENV{'user.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/$ENV{'user.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("<br />",keys %hash);
#		print "<br />$key<br />$keyz".$hash{'pre_'.$key.'_link'}."<br />\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;
		    }
		}
	    }
	}
    } else {
	$r->print('Unable to tie hash to db file</body></html>');
	return OK;
    }
    untie %hash;
    my $ctr = 0;
    my $clen = scalar(keys %shash);
    if ($clen > 1) {
	my %lt=&Apache::lonlocal::texthash(
		'fin'=> 'Finalize order of resources',
		'gb' => 'Go Back',
		'ns' => 'New Search',
		'fi' => 'Finish Import',
		'ca' => 'Cancel',
		'co' => 'Change Order',
		'ti' => 'Title',
		'pa' => 'Path'
		);
	$r->print(&Apache::loncommon::bodytag('Sort Imported Resources'));
	$r->print(<<END);
<b><font color="#888888">$lt{'fin'}</font></b>
<form method='post' action='/adm/groupsort' name='groupsort'
      enctype='application/x-www-form-urlencoded'>
<input type="hidden" name="fnum" value="$clen" />
<input type="hidden" name="oldval" value="" />
<input type="hidden" name="newval" value="" />
<input type="hidden" name="mode" value="$ENV{'form.mode'}" />
END

        # --- Expand here if "GO BACK" button desired
        if ($ENV{'form.catalogmode'} eq 'groupimport') {
	    $r->print(<<END);
<input type="button" name="alter" value="$lt{'gb'}"
 onClick="window.location='/res/?catalogmode=groupimport'" />&nbsp;
END
        }
	if ($ENV{'form.catalogmode'} eq 'groupsearch') {
	    $r->print(<<END);
<input type="button" name="alter" value="$lt{'ns'}"
 onClick="window.location='/adm/searchcat?catalogmode=groupsearch&cleargroupsort=1'" />&nbsp;
END
        }
        # ---

	$r->print(<<END);
<input type="button" name="alter" value="$lt{'fi'}"
 onClick="finish_import()" />&nbsp;
<input type="button" name="alter" value="$lt{'ca'}" onClick="self.close()" />
END
        $r->print("<table border='0'><tr><td bgcolor='#eeeeee'>");
	$r->print("<table border=0><tr>\n");
	$r->print("<td colspan='2' bgcolor='$titleclr'><b>$lt{'co'}</b></td>\n");
	$r->print("<td colspan='2' bgcolor='$titleclr'><b>$lt{'ti'}</b></td>\n");
	$r->print("<td bgcolor='$titleclr'><b>$lt{'pa'}</b></td></tr>\n");
    } else {
	$r->print(<<END);
<body>
<form method='post' action='/adm/groupsort' name='groupsort'
      enctype='application/x-www-form-urlencoded'>
<input type="hidden" name="fnum" value="$clen" />
<input type="hidden" name="oldval" value="" />
<input type="hidden" name="newval" value="" />
<input type="hidden" name="mode" value="$ENV{'form.mode'}" />
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];
	my $iconname="unknown.gif";
	my $embstyle = &Apache::loncommon::fileembstyle($curfext);
	# The unless conditional that follows is a bit of overkill
	$iconname = $curfext.".gif" unless
	    (!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn');
	if ($clen > 1) {
	    $r->print("<tr><td bgcolor='$fileclr'>");
	    $r->print(&movers($clen,$ctr));
	}
	$r->print(&hidden($ctr-1,$thash{$key},$key));
	if ($clen > 1) {
	    $r->print("</td><td bgcolor='$fileclr'>");
	    $r->print(&select_box($clen,$ctr));
	    $r->print("</td><td bgcolor='$fileclr'>");
	    $r->print("<img src='$iconpath$iconname'>");
	    $r->print("</td><td bgcolor='$fileclr'>");
	    $r->print("$thash{$key}</td><td bgcolor='$fileclr'>\n");
	    $r->print("$key</td></tr>\n");
	} 
    }
    if ($clen > 1) {
	$r->print("</table></td></tr></table></form>");
    } else {
	$r->print(<<END);
<script type="text/javascript">
    finish_import();
</script>
END
    }
    $r->print(<<END);
</body>
</html>
END

    return OK;
}

# --------------------------------------- Hidden values (returns scalar string)
sub hidden {
    my ($sel,$title,$filelink) = @_;
    my $string = '<input type="hidden" name="title'.$sel.'" value="'.$title.
	'" />';
    $string .= '<input type="hidden" name="filelink'.$sel.'" value="'.
	$filelink.'" />';
    return $string;
}

# --------------------------------------- Moving arrows (returns scalar string)
sub movers {
    my ($total,$sel) = @_;
    my $dsel = $sel-1;
    my $usel = $sel+1;
    $usel = 1 if $usel > $total;
    $dsel = $total if $dsel < 1;
    my $string;
    $string = (<<END);
<table border='0' cellspacing='0' cellpadding='0'>
<tr><td><a href='javascript:move($sel,$dsel)'>
<img src="${iconpath}move_up.gif" alt='UP' border='0' /></a></td></tr>
<tr><td><a href='javascript:move($sel,$usel)'>
<img src="${iconpath}move_down.gif" alt='DOWN' border='0' /></a></td></tr>
</table>
END
    return $string;
}

# ------------------------------------------ Select box (returns scalar string)
sub select_box {
    my ($total,$sel) = @_;
    my $string;
    $string = '<select name="alt'.$sel.'"';
    $string .= " onChange='selectchange($sel)'>";
    $string .= "<option name='o0' value='0'>remove</option>";
    for my $cur (1..$total) {
	$string .= "<option name='o$cur' value='$cur'";
	if ($cur == $sel) {
	    $string .= "selected";
	}
	$string .= ">$cur</option>";
    }
    $string .= "</select>\n";
    return $string;
}

1;

__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
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.