Annotation of rat/lonsequence.pm, revision 1.15

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

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.