--- loncom/lonnet/perl/lonnet.pm 2003/02/13 21:35:50 1.327 +++ loncom/lonnet/perl/lonnet.pm 2003/03/06 21:08:21 1.333 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.327 2003/02/13 21:35:50 albertel Exp $ +# $Id: lonnet.pm,v 1.333 2003/03/06 21:08:21 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -76,7 +76,7 @@ qw(%perlvar %hostname %homecache %badSer %libserv %pr %prp %metacache %packagetab %titlecache %courselogs %accesshash $processmarker $dumpcount %coursedombuf %coursehombuf %courseresdatacache - %domaindescription %domain_auth_def %domain_auth_arg_def); + %domaindescription %domain_auth_def %domain_auth_arg_def $tmpdir); use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); @@ -804,6 +804,18 @@ sub repcopy { } } +# ------------------------------------------------ Get server side include body +sub ssi_body { + my $filelink=shift; + my $output=($filelink=~/^http\:/?&externalssi($filelink): + &ssi($filelink)); + $output=~s/^.*\]*\>//si; + $output=~s/\<\/body\s*\>.*$//si; + $output=~ + s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs; + return $output; +} + # --------------------------------------------------------- Server Side Include sub ssi { @@ -1755,7 +1767,7 @@ sub dump { # --------------------------------------------------------------- currentdump sub currentdump { - my ($sname,$sdom,$courseid)=@_; + my ($courseid,$sdom,$sname)=@_; $courseid = $ENV{'request.course.id'} if (! defined($courseid)); $sdom = $ENV{'user.domain'} if (! defined($sdom)); $sname = $ENV{'user.name'} if (! defined($sname)); @@ -2157,6 +2169,7 @@ sub is_on_map { my $filename=$uriparts[$#uriparts]; my $pathname=$uri; $pathname=~s|/\Q$filename\E$||; + $pathname=~s/^adm\/wrapper\///; #Trying to find the conditional for the file my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ /\&\Q$filename\E\:([\d\|]+)\&/); @@ -3068,12 +3081,19 @@ sub metadata { # my $package=$token->[2]->{'package'}; my $keyroot=''; - if ($prefix) { - $keyroot.=$prefix; - } else { - if (defined($token->[2]->{'part'})) { - $keyroot.='_'.$token->[2]->{'part'}; - } + if (defined($prefix) && $prefix !~ /^__/) { + # prefix that has a part already + $keyroot=$prefix; + } elsif (defined($prefix)) { + # prefix that is missing a part + if (defined($token->[2]->{'part'})) { + $keyroot='_'.$token->[2]->{'part'}.substr($prefix,1); + } + } else { + # no prefix at all + if (defined($token->[2]->{'part'})) { + $keyroot='_'.$token->[2]->{'part'}; + } } if (defined($token->[2]->{'id'})) { $keyroot.='_'.$token->[2]->{'id'}; @@ -3670,6 +3690,12 @@ BEGIN { } } +# ------------- set up temporary directory +{ + $tmpdir = $perlvar{'lonDaemons'}.'/tmp/'; + +} + %metacache=(); $processmarker='_'.time.'_'.$perlvar{'lonHostID'};