File:  [LON-CAPA] / rat / lonsequence.pm
Revision 1.13: download - view: text, annotated - select for diffs
Mon Aug 12 18:21:42 2002 UTC (21 years, 8 months ago) by albertel
Branches: MAIN
CVS tags: version_0_5_1, version_0_5, HEAD
- i think the last of bug#574

    1: # The LearningOnline Network with CAPA
    2: #
    3: # Sequence Handler
    4: #
    5: # $Id: lonsequence.pm,v 1.13 2002/08/12 18:21:42 albertel 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: # (Handler to resolve ambiguous file locations
   30: #
   31: # (TeX Content Handler
   32: #
   33: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
   34: #
   35: # 10/11,10/12 Gerd Kortemeyer)
   36: #
   37: # 10/16 Gerd Kortemeyer
   38: 
   39: package Apache::lonsequence;
   40: 
   41: use strict;
   42: use Apache::lonnet;
   43: use Apache::Constants qw(:common :http REDIRECT);
   44: use GDBM_File;
   45: use Apache::lonratedt;
   46: use Apache::lonratsrv;
   47: use Apache::lonpageflip;
   48: 
   49: my %selhash;
   50: my $successtied;
   51: 
   52: # ----------------------------------------- Attempt to read from resource space
   53: 
   54: sub attemptread {
   55:     my $fn=shift;
   56:     &Apache::lonnet::repcopy($fn);
   57:     if (-e $fn) {
   58: 	return &Apache::lonratedt::attemptread($fn);
   59:     } else {
   60:         return ();
   61:     }
   62: }
   63: 
   64: # ---------------------------------------------------------------- View Handler
   65: 
   66: sub viewmap {
   67:     my ($r,$url)=@_;
   68:     $r->print('<html>');
   69:     if ($ENV{'form.forceselect'}) { $r->print(<<ENDSCRIPT);
   70: <script>
   71: 
   72: function select_group() {
   73:     window.location="/adm/groupsort?catalogmode=groupsec&mode=rat&acts="+document.forms.fileattr.acts.value;
   74: }
   75: 
   76: function queue(val) {
   77:     if (eval("document.forms."+val+".filelink.checked")) {
   78: 	var l=val.length;
   79: 	var v=val.substring(4,l);
   80: 	document.forms.fileattr.acts.value+='1a'+v+'b';
   81:     }
   82:     else {
   83: 	var l=val.length;
   84: 	var v=val.substring(4,l);
   85: 	document.forms.fileattr.acts.value+='0a'+v+'b';
   86:     }
   87: }
   88: 
   89: </script>
   90: ENDSCRIPT
   91:     }
   92:     $r->print('<body bgcolor="#FFFFFF">');
   93: # ------------------ This is trying to select. Provide buttons and tie %selhash
   94:     if ($ENV{'form.forceselect'}) { $r->print(<<ENDSELECT);
   95: <form name=fileattr><input type=hidden name=acts value=''>
   96: <input type="button" name="close" value='CLOSE' onClick="self.close()">
   97: <input type="button" name="groupimport" value='GROUP IMPORT'
   98: onClick="javascript:select_group()">
   99: </form>   
  100: ENDSELECT
  101:     my $diropendb = 
  102:     "/home/httpd/perl/tmp/$ENV{'user.domain'}\_$ENV{'user.name'}_groupsec.db";
  103:         if (tie(%selhash,'GDBM_File',$diropendb,&GDBM_WRCREAT(),0640)) {
  104: 	    if ($ENV{'form.launch'} eq '1') {
  105: 	       &start_fresh_session();
  106: 	    }
  107:             $successtied=1;
  108: 
  109: # - Evaluate actions from previous page (both cumulatively and chronologically)
  110:         if ($ENV{'form.catalogmode'} eq 'groupimport') {
  111: 	    my $acts=$ENV{'form.acts'};
  112: 	    my @Acts=split(/b/,$acts);
  113: 	    my %ahash;
  114: 	    my %achash;
  115: 	    my $ac=0;
  116: 	    # some initial hashes for working with data
  117: 	    foreach (@Acts) {
  118: 		my ($state,$ref)=split(/a/);
  119: 		$ahash{$ref}=$state;
  120: 		$achash{$ref}=$ac;
  121: 		$ac++;
  122: 	    }
  123: 	    # sorting through the actions and changing the tied database hash
  124: 	    foreach (sort {$achash{$a}<=>$achash{$b}} (keys %ahash)) {
  125: 		my $key=$_;
  126: 		if ($ahash{$key} eq '1') {
  127: 		    $selhash{'store_'.$selhash{'pre_'.$key.'_link'}}=
  128: 			$selhash{'pre_'.$key.'_title'};
  129: 		    $selhash{'storectr_'.$selhash{'pre_'.$key.'_link'}}=
  130: 			$selhash{'storectr'}+0;
  131: 		    $selhash{'storectr'}++;
  132: 		}
  133: 		if ($ahash{$key} eq '0') {
  134: 		    if ($selhash{'store_'.$selhash{'pre_'.$key.'_link'}}) {
  135: 		       delete $selhash{'store_'.$selhash{'pre_'.$key.'_link'}};
  136: 		    }
  137: 		}
  138: 	    }
  139: 	    # deleting the previously cached listing
  140: 	    foreach (keys %selhash) {
  141: 		if ($_ =~ /^pre_/ && $_ =~/link$/) {
  142: 		    my $key = $_;
  143: 		    $key =~ s/^pre_//;
  144: 		    $key =~ s/_[^_]*$//;
  145: 		    delete $selhash{'pre_'.$key.'_title'};
  146: 		    delete $selhash{'pre_'.$key.'_link'};
  147: 		}
  148: 	    }
  149: 	}
  150: # -
  151:         }
  152:     }
  153: # ----------------------------- successtied is now '1' if in working selectmode
  154:     my $idx=0;
  155:     foreach (&attemptread(&Apache::lonnet::filelocation('',$url))) {
  156: 	if (defined($_)) {
  157:             $idx++;
  158:             if ($successtied) { 
  159: 		$r->print('<form name="form'.$idx.'">');
  160:             }
  161: 	    my ($title,$url)=split(/\:/,$_);
  162:             $title=~s/\&colon\;/\:/g;
  163:             $url=~s/\&colon\;/\:/g;
  164:             unless ($title) { $title=(split(/\//,$url))[-1] };
  165:             unless ($title) { $title='<i>Empty</i>'; }
  166:             if ($url) {
  167: 		if ($successtied) {
  168: 		    my $checked='';
  169: 	           if ($selhash{'store_'.$url}) {
  170: 	       	      $checked=" checked";
  171: 	           }
  172: 	           $selhash{"pre_${idx}_link"}=$url;
  173: 	           $selhash{"pre_${idx}_title"}=$title;
  174: 
  175: 		    $r->print(<<ENDCHECKBOX);
  176: <input type='checkbox' name='filelink' 
  177: value='$url' onClick='javascript:queue("form$idx")'$checked>
  178: <input type='hidden' name='title' value='$title'>
  179: ENDCHECKBOX
  180:                 }
  181: 		$r->print('<a href="'.&Apache::lonratsrv::qtescape($url).'">');
  182:             }
  183:             $r->print(&Apache::lonratsrv::qtescape($title));
  184:             if ($url) { $r->print('</a>'); }
  185:             if ($successtied) {
  186: 		$r->print('</form>');
  187:             } else {
  188: 		$r->print('<br>');
  189:             }
  190:         }
  191:     }
  192:     $r->print('</body></html>');
  193:     if ($successtied) {
  194: 	untie %selhash;
  195:     }
  196: }
  197: 
  198: # ----------------------------------------------------------- Clean out selhash
  199: sub start_fresh_session {
  200:     foreach (keys %selhash) {
  201: 	if ($_ =~ /^pre_/) {
  202: 	    delete $selhash{$_};
  203: 	}
  204: 	if ($_ =~ /^store/) {
  205: 	    delete $selhash{$_};
  206: 	}
  207:     }
  208: }
  209: 
  210: 
  211: # ================================================================ Main Handler
  212: 
  213: sub handler {
  214:    my $r=shift;
  215: 
  216:    if ($r->header_only) {
  217:       $r->content_type('text/html');
  218:       $r->send_http_header;
  219:       return OK;
  220:    }
  221:  
  222:    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  223:                                           ['forceselect','launch']);
  224: 
  225:    my %hash;
  226:    my %bighash;
  227:    my $requrl=$r->uri;
  228: 
  229:    $successtied=0;
  230: # ------------------------------------------------------------ Tie symb db file
  231:   my $disurl='';
  232:   my $dismapid='';
  233: 
  234:   if (($ENV{'request.course.fn'}) && (!$ENV{'form.forceselect'})) {
  235:        my $last;
  236:        if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
  237:                     &GDBM_READER(),0640)) {
  238: 	   $last=$hash{'last_direction'};
  239:            untie(%hash);
  240:        }
  241:        my $direction='';
  242:        my $prevmap='';
  243:        if ($last) {
  244: 	  ($prevmap,$direction)=(split(/\_\_\_/,$last));
  245:        }
  246: # ------------------------------------------------------------- Tie big db file
  247:        if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
  248:                     &GDBM_READER(),0640)) {
  249: 	   my $disid='';
  250: 
  251:            if ($direction eq 'back') {
  252: 	       $disid=$bighash{'map_finish_'.$requrl};
  253:            } else {
  254:                $disid=$bighash{'map_start_'.$requrl};
  255:            } 
  256:            if ($disid) {
  257: 	       $disurl=$bighash{'src_'.$disid};
  258:                $dismapid=(split(/\./,$disid))[1];
  259:            }
  260: # ------------------------- If this is an empty one, skip to next non-empty one
  261:            if ((!$disurl) && ($disid)) {
  262: 	       $direction=($direction?$direction:'forward');
  263:                ($disid,$requrl)=
  264:                          &Apache::lonpageflip::fullmove($disid,
  265:                            &Apache::lonnet::declutter($requrl),$direction);
  266:                if ($disid) {
  267: 	           $disurl=$bighash{'src_'.$disid};
  268:                    $dismapid=(split(/\./,$disid))[1];
  269:                }
  270:  	   }
  271: 
  272: # --------------------------------------- Untie hash, make sure to come by here
  273:            untie(%bighash);
  274:        }
  275:    }
  276: 
  277: # now either disurl is set (going to first page), or we need another display
  278: 
  279:    if ($disurl) {
  280: # -------------------------------------------------- Has first or last resource
  281:       &Apache::lonnet::symblist($requrl,$disurl => $dismapid,
  282:                    'last_known' => &Apache::lonnet::declutter($disurl)); 
  283:       $r->content_type('text/html');
  284:       $r->header_out(Location => 'http://'.$ENV{'HTTP_HOST'}.$disurl);
  285:       return REDIRECT;
  286:    } else {
  287:        $r->content_type('text/html');
  288:        $r->send_http_header;
  289:        &viewmap($r,$requrl);
  290:        return OK;
  291:    }
  292: }
  293: 
  294: 1;
  295: __END__
  296: 
  297: 
  298: 
  299: 
  300: 
  301: 
  302: 

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