Annotation of rat/lonsequence.pm, revision 1.27

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

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.