--- loncom/lonnet/perl/lonnet.pm 2003/11/11 20:10:32 1.447
+++ loncom/lonnet/perl/lonnet.pm 2003/12/05 00:28:32 1.454
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.447 2003/11/11 20:10:32 www Exp $
+# $Id: lonnet.pm,v 1.454 2003/12/05 00:28:32 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -30,7 +30,6 @@
package Apache::lonnet;
use strict;
-use Apache::File;
use LWP::UserAgent();
use HTTP::Headers;
use vars
@@ -52,12 +51,35 @@ use Storable qw(lock_store lock_nstore l
use Time::HiRes();
my $readit;
+=pod
+
+=head1 Package Variables
+
+These are largely undocumented, so if you decipher one please note it here.
+
+=over 4
+
+=item $processmarker
+
+Contains the time this process was started and this servers host id.
+
+=item $dumpcount
+
+Counts the number of times a message log flush has been attempted (regardless
+of success) by this process. Used as part of the filename when messages are
+delayed.
+
+=back
+
+=cut
+
+
# --------------------------------------------------------------------- Logging
sub logtouch {
my $execdir=$perlvar{'lonDaemons'};
- unless (-e "$execdir/logs/lonnet.log") {
- my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");
+ unless (-e "$execdir/logs/lonnet.log") {
+ open(my $fh,">>$execdir/logs/lonnet.log");
close $fh;
}
my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];
@@ -69,8 +91,10 @@ sub logthis {
my $execdir=$perlvar{'lonDaemons'};
my $now=time;
my $local=localtime($now);
- my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");
- print $fh "$local ($$): $message\n";
+ if (open(my $fh,">>$execdir/logs/lonnet.log")) {
+ print $fh "$local ($$): $message\n";
+ close($fh);
+ }
return 1;
}
@@ -79,8 +103,10 @@ sub logperm {
my $execdir=$perlvar{'lonDaemons'};
my $now=time;
my $local=localtime($now);
- my $fh=Apache::File->new(">>$execdir/logs/lonnet.perm.log");
- print $fh "$now:$message:$local\n";
+ if (open(my $fh,">>$execdir/logs/lonnet.perm.log")) {
+ print $fh "$now:$message:$local\n";
+ close($fh);
+ }
return 1;
}
@@ -132,7 +158,7 @@ sub reconlonc {
my $peerfile=shift;
&logthis("Trying to reconnect for $peerfile");
my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
- if (my $fh=Apache::File->new("$loncfile")) {
+ if (open(my $fh,"<$loncfile")) {
my $loncpid=<$fh>;
chomp($loncpid);
if (kill 0 => $loncpid) {
@@ -180,18 +206,20 @@ sub critical {
"$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server";
$dumpcount++;
{
- my $dfh;
- if ($dfh=Apache::File->new(">$dfilename")) {
- print $dfh "$cmd\n";
- }
+ my $dfh;
+ if (open($dfh,">$dfilename")) {
+ print $dfh "$cmd\n";
+ close($dfh);
+ }
}
sleep 2;
my $wcmd='';
{
- my $dfh;
- if ($dfh=Apache::File->new("$dfilename")) {
- $wcmd=<$dfh>;
- }
+ my $dfh;
+ if (open($dfh,"<$dfilename")) {
+ $wcmd=<$dfh>;
+ close($dfh);
+ }
}
chomp($wcmd);
if ($wcmd eq $cmd) {
@@ -230,10 +258,10 @@ sub transfer_profile_to_env {
my ($lonidsdir,$handle)=@_;
my @profile;
{
- my $idf=Apache::File->new("$lonidsdir/$handle.id");
+ open(my $idf,"$lonidsdir/$handle.id");
flock($idf,LOCK_SH);
@profile=<$idf>;
- $idf->close();
+ close($idf);
}
my $envi;
my %Remove;
@@ -269,47 +297,47 @@ sub appenv {
}
my $lockfh;
- unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {
- return 'error: '.$!;
+ unless (open($lockfh,"$ENV{'user.environment'}")) {
+ return 'error: '.$!;
}
unless (flock($lockfh,LOCK_EX)) {
&logthis("<font color=blue>WARNING: ".
'Could not obtain exclusive lock in appenv: '.$!);
- $lockfh->close();
+ close($lockfh);
return 'error: '.$!;
}
my @oldenv;
{
- my $fh;
- unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
- return 'error: '.$!;
- }
- @oldenv=<$fh>;
- $fh->close();
+ my $fh;
+ unless (open($fh,"$ENV{'user.environment'}")) {
+ return 'error: '.$!;
+ }
+ @oldenv=<$fh>;
+ close($fh);
}
for (my $i=0; $i<=$#oldenv; $i++) {
chomp($oldenv[$i]);
if ($oldenv[$i] ne '') {
- my ($name,$value)=split(/=/,$oldenv[$i]);
- unless (defined($newenv{$name})) {
- $newenv{$name}=$value;
- }
+ my ($name,$value)=split(/=/,$oldenv[$i]);
+ unless (defined($newenv{$name})) {
+ $newenv{$name}=$value;
+ }
}
}
{
- my $fh;
- unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
- return 'error';
- }
- my $newname;
- foreach $newname (keys %newenv) {
- print $fh "$newname=$newenv{$newname}\n";
- }
- $fh->close();
+ my $fh;
+ unless (open($fh,">$ENV{'user.environment'}")) {
+ return 'error';
+ }
+ my $newname;
+ foreach $newname (keys %newenv) {
+ print $fh "$newname=$newenv{$newname}\n";
+ }
+ close($fh);
}
-
- $lockfh->close();
+
+ close($lockfh);
return 'ok';
}
# ----------------------------------------------------- Delete from Environment
@@ -324,34 +352,34 @@ sub delenv {
}
my @oldenv;
{
- my $fh;
- unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
- return 'error';
- }
- unless (flock($fh,LOCK_SH)) {
- &logthis("<font color=blue>WARNING: ".
- 'Could not obtain shared lock in delenv: '.$!);
- $fh->close();
- return 'error: '.$!;
- }
- @oldenv=<$fh>;
- $fh->close();
+ my $fh;
+ unless (open($fh,"$ENV{'user.environment'}")) {
+ return 'error';
+ }
+ unless (flock($fh,LOCK_SH)) {
+ &logthis("<font color=blue>WARNING: ".
+ 'Could not obtain shared lock in delenv: '.$!);
+ close($fh);
+ return 'error: '.$!;
+ }
+ @oldenv=<$fh>;
+ close($fh);
}
{
- my $fh;
- unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
- return 'error';
- }
- unless (flock($fh,LOCK_EX)) {
- &logthis("<font color=blue>WARNING: ".
- 'Could not obtain exclusive lock in delenv: '.$!);
- $fh->close();
- return 'error: '.$!;
- }
- foreach (@oldenv) {
- unless ($_=~/^$delthis/) { print $fh $_; }
- }
- $fh->close();
+ my $fh;
+ unless (open($fh,">$ENV{'user.environment'}")) {
+ return 'error';
+ }
+ unless (flock($fh,LOCK_EX)) {
+ &logthis("<font color=blue>WARNING: ".
+ 'Could not obtain exclusive lock in delenv: '.$!);
+ close($fh);
+ return 'error: '.$!;
+ }
+ foreach (@oldenv) {
+ unless ($_=~/^$delthis/) { print $fh $_; }
+ }
+ close($fh);
}
return 'ok';
}
@@ -387,10 +415,11 @@ sub overloaderror {
unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
my $loadavg;
if ($checkserver eq $perlvar{'lonHostID'}) {
- my $loadfile=Apache::File->new('/proc/loadavg');
+ open(my $loadfile,'/proc/loadavg');
$loadavg=<$loadfile>;
$loadavg =~ s/\s.*//g;
$loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
+ close($loadfile);
} else {
$loadavg=&reply('load',$checkserver);
}
@@ -819,10 +848,14 @@ sub getsection {
return '-1';
}
+
+my $disk_caching_disabled=1;
+
sub devalidate_cache {
my ($cache,$id,$name) = @_;
delete $$cache{$id.'.time'};
delete $$cache{$id};
+ if ($disk_caching_disabled) { return; }
my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
open(DB,"$filename.lock");
flock(DB,LOCK_EX);
@@ -878,6 +911,7 @@ sub do_cache {
sub save_cache_item {
my ($cache,$name,$id)=@_;
+ if ($disk_caching_disabled) { return; }
my $starttime=&Time::HiRes::time();
# &logthis("Saving :$name:$id");
my %hash;
@@ -907,6 +941,7 @@ EVALBLOCK
sub load_cache_item {
my ($cache,$name,$id)=@_;
+ if ($disk_caching_disabled) { return; }
my $starttime=&Time::HiRes::time();
# &logthis("Before Loading $name for $id size is ".scalar(%$cache));
my %hash;
@@ -1124,8 +1159,8 @@ sub ssi_body {
my ($filelink,%form)=@_;
my $output=($filelink=~/^http\:/?&externalssi($filelink):
&ssi($filelink,%form));
- $output=~s/^.*\<body[^\>]*\>//si;
- $output=~s/\<\/body\s*\>.*$//si;
+ $output=~s/^.*?\<body[^\>]*\>//si;
+ $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;
$output=~
s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;
return $output;
@@ -1229,8 +1264,9 @@ sub finishuserfileupload {
}
# Save the file
{
- my $fh=Apache::File->new('>'.$filepath.'/'.$fname);
+ open(my $fh,'>'.$filepath.'/'.$fname);
print $fh $ENV{'form.'.$formname};
+ close($fh);
}
# Notify homeserver to grep it
#
@@ -1304,12 +1340,27 @@ sub flushcourselogs {
# File accesses
# Writes to the dynamic metadata of resources to get hit counts, etc.
#
- foreach (keys %accesshash) {
- my $entry=$_;
- $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
- my %temphash=($entry => $accesshash{$entry});
- if (&Apache::lonnet::put('nohist_resevaldata',\%temphash,$1,$2) eq 'ok') {
- delete $accesshash{$entry};
+ foreach my $entry (keys(%accesshash)) {
+ my ($dom,$name,undef,$type)=($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
+ if ($type eq 'count'){
+ my $value = $accesshash{$entry};
+ my (undef,$url,undef) = ($entry =~ /^(.*)___(.*)___count$/);
+ my %temphash=($url => $value);
+ my $result = &inc('nohist_accesscount',\%temphash,$dom,$name);
+ if ($result eq 'ok') {
+ delete $accesshash{$entry};
+ } elsif ($result eq 'unknown_cmd') {
+ # Target server has old code running on it.
+ my %temphash=($entry => $value);
+ if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
+ delete $accesshash{$entry};
+ }
+ }
+ } else {
+ my %temphash=($entry => $accesshash{$entry});
+ if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
+ delete $accesshash{$entry};
+ }
}
}
#
@@ -1346,7 +1397,8 @@ sub courselog {
} else {
$courselogs{$ENV{'request.course.id'}}.=$what;
}
- if (length($courselogs{$ENV{'request.course.id'}})>4048) {
+# if (length($courselogs{$ENV{'request.course.id'}})>4048) {
+ if (length($courselogs{$ENV{'request.course.id'}})>48) {
&flushcourselogs();
}
}
@@ -1371,11 +1423,7 @@ sub countacc {
unless ($ENV{'request.course.id'}) { return ''; }
$accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';
- if (defined($accesshash{$key})) {
- $accesshash{$key}++;
- } else {
- $accesshash{$key}=1;
- }
+ $accesshash{$key}++;
}
sub linklog {
@@ -1454,10 +1502,11 @@ sub postannounce {
}
sub getannounce {
- if (my $fh=Apache::File->new($perlvar{'lonDocRoot'}.'/announcement.txt')) {
+
+ if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {
my $announcement='';
while (<$fh>) { $announcement .=$_; }
- $fh->close();
+ close($fh);
if ($announcement=~/\w/) {
return
'<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.
@@ -2344,6 +2393,30 @@ sub convert_dump_to_currentdump{
return \%returnhash;
}
+# --------------------------------------------------------------- inc interface
+
+sub inc {
+ my ($namespace,$store,$udomain,$uname) = @_;
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+ my $items='';
+ if (! ref($store)) {
+ # got a single value, so use that instead
+ $items = &escape($store).'=&';
+ } elsif (ref($store) eq 'SCALAR') {
+ $items = &escape($$store).'=&';
+ } elsif (ref($store) eq 'ARRAY') {
+ $items = join('=&',map {&escape($_);} @{$store});
+ } elsif (ref($store) eq 'HASH') {
+ while (my($key,$value) = each(%{$store})) {
+ $items.= &escape($key).'='.&escape($value).'&';
+ }
+ }
+ $items=~s/\&$//;
+ return &reply("inc:$udomain:$uname:$namespace:$items",$uhome);
+}
+
# --------------------------------------------------------------- put interface
sub put {
@@ -2844,9 +2917,9 @@ sub get_query_reply {
for (1..100) {
sleep 2;
if (-e $replyfile.'.end') {
- if (my $fh=Apache::File->new($replyfile)) {
+ if (open(my $fh,$replyfile)) {
$reply.=<$fh>;
- $fh->close;
+ close($fh);
} else { return 'error: reply_file_error'; }
return &unescape($reply);
}
@@ -3621,10 +3694,8 @@ sub EXT {
my $hashid="$udom:$uname";
my ($result,$cached)=&is_cached(\%userresdatacache,$hashid,
'userres');
- if (!defined($cached)) {
- my %resourcedata=&get('resourcedata',
- [$courselevelr,$courselevelm,
- $courselevel],$udom,$uname);
+ if (!defined($cached)) {
+ my %resourcedata=&dump('resourcedata',$udom,$uname);
$result=\%resourcedata;
&do_cache(\%userresdatacache,$hashid,$result,'userres');
}
@@ -3773,7 +3844,9 @@ sub metadata {
#
# Is this a recursive call for a library?
#
- my %lcmetacache;
+ if (! exists($metacache{$uri})) {
+ $metacache{$uri}={};
+ }
if ($liburi) {
$liburi=&declutter($liburi);
$filename=$liburi;
@@ -3797,10 +3870,10 @@ sub metadata {
if (defined($token->[2]->{'id'})) {
$keyroot.='_'.$token->[2]->{'id'};
}
- if ($lcmetacache{':packages'}) {
- $lcmetacache{':packages'}.=','.$package.$keyroot;
+ if ($metacache{$uri}->{':packages'}) {
+ $metacache{$uri}->{':packages'}.=','.$package.$keyroot;
} else {
- $lcmetacache{':packages'}=$package.$keyroot;
+ $metacache{$uri}->{':packages'}=$package.$keyroot;
}
foreach (keys %packagetab) {
my $part=$keyroot;
@@ -3822,14 +3895,14 @@ sub metadata {
if ($subp eq 'display') {
$value.=' [Part: '.$part.']';
}
- $lcmetacache{':'.$unikey.'.part'}=$part;
+ $metacache{$uri}->{':'.$unikey.'.part'}=$part;
$metathesekeys{$unikey}=1;
- unless (defined($lcmetacache{':'.$unikey.'.'.$subp})) {
- $lcmetacache{':'.$unikey.'.'.$subp}=$value;
+ unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {
+ $metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;
}
- if (defined($lcmetacache{':'.$unikey.'.default'})) {
- $lcmetacache{':'.$unikey}=
- $lcmetacache{':'.$unikey.'.default'};
+ if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {
+ $metacache{$uri}->{':'.$unikey}=
+ $metacache{$uri}->{':'.$unikey.'.default'};
}
}
}
@@ -3862,6 +3935,7 @@ sub metadata {
foreach (sort(split(/\,/,&metadata($uri,'keys',
$location,$unikey,
$depthcount+1)))) {
+ $metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
$metathesekeys{$_}=1;
}
}
@@ -3872,18 +3946,18 @@ sub metadata {
}
$metathesekeys{$unikey}=1;
foreach (@{$token->[3]}) {
- $lcmetacache{':'.$unikey.'.'.$_}=$token->[2]->{$_};
+ $metacache{$uri}->{':'.$unikey.'.'.$_}=$token->[2]->{$_};
}
my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));
- my $default=$lcmetacache{':'.$unikey.'.default'};
+ my $default=$metacache{$uri}->{':'.$unikey.'.default'};
if ( $internaltext =~ /^\s*$/ && $default !~ /^\s*$/) {
# only ws inside the tag, and not in default, so use default
# as value
- $lcmetacache{':'.$unikey}=$default;
+ $metacache{$uri}->{':'.$unikey}=$default;
} else {
# either something interesting inside the tag or default
# uninteresting
- $lcmetacache{':'.$unikey}=$internaltext;
+ $metacache{$uri}->{':'.$unikey}=$internaltext;
}
# end of not-a-package not-a-library import
}
@@ -3893,27 +3967,28 @@ sub metadata {
}
}
# are there custom rights to evaluate
- if ($lcmetacache{':copyright'} eq 'custom') {
+ if ($metacache{$uri}->{':copyright'} eq 'custom') {
#
# Importing a rights file here
#
unless ($depthcount) {
- my $location=$lcmetacache{':customdistributionfile'};
+ my $location=$metacache{$uri}->{':customdistributionfile'};
my $dir=$filename;
$dir=~s|[^/]*$||;
$location=&filelocation($dir,$location);
foreach (sort(split(/\,/,&metadata($uri,'keys',
$location,'_rights',
$depthcount+1)))) {
+ $metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
$metathesekeys{$_}=1;
}
}
}
- $lcmetacache{':keys'}=join(',',keys %metathesekeys);
- &metadata_generate_part0(\%metathesekeys,\%lcmetacache,$uri);
- $lcmetacache{':allpossiblekeys'}=join(',',keys %metathesekeys);
- &do_cache(\%metacache,$uri,\%lcmetacache,'meta');
+ $metacache{$uri}->{':keys'}=join(',',keys %metathesekeys);
+ &metadata_generate_part0(\%metathesekeys,$metacache{$uri},$uri);
+ $metacache{$uri}->{':allpossiblekeys'}=join(',',keys %metathesekeys);
+ &do_cache(\%metacache,$uri,$metacache{$uri},'meta');
# this is the end of "was not already recently cached
}
return $metacache{$uri}->{':'.$what};
@@ -4337,7 +4412,8 @@ sub getfile {
} else { # normal file from res space
&repcopy($file);
if (! -e $file ) { return -1; };
- my $fh=Apache::File->new($file);
+ my $fh;
+ open($fh,"<$file");
my $a='';
while (<$fh>) { $a .=$_; }
return $a;
@@ -4453,7 +4529,7 @@ BEGIN {
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf
unless ($readit) {
{
- my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf");
+ open(my $config,"</etc/httpd/conf/loncapa.conf");
while (my $configline=<$config>) {
if ($configline =~ /^[^\#]*PerlSetVar/) {
@@ -4462,9 +4538,10 @@ BEGIN {
$perlvar{$varname}=$varvalue;
}
}
+ close($config);
}
{
- my $config=Apache::File->new("/etc/httpd/conf/loncapa_apache.conf");
+ open(my $config,"</etc/httpd/conf/loncapa_apache.conf");
while (my $configline=<$config>) {
if ($configline =~ /^[^\#]*PerlSetVar/) {
@@ -4473,16 +4550,16 @@ BEGIN {
$perlvar{$varname}=$varvalue;
}
}
+ close($config);
}
# ------------------------------------------------------------ Read domain file
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/domain.tab');
%domaindescription = ();
%domain_auth_def = ();
%domain_auth_arg_def = ();
- if ($fh) {
+ my $fh;
+ if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
while (<$fh>) {
next if (/^(\#|\s*$)/);
# next if /^\#/;
@@ -4497,16 +4574,17 @@ BEGIN {
$domain_longi{$domain}=$longi;
$domain_lati{$domain}=$lati;
-# &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
+ # &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
# &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
- }
+ }
}
+ close ($fh);
}
# ------------------------------------------------------------- Read hosts file
{
- my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
+ open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
while (my $configline=<$config>) {
next if ($configline =~ /^(\#|\s*$)/);
@@ -4524,11 +4602,12 @@ BEGIN {
}
}
}
+ close($config);
}
# ------------------------------------------------------ Read spare server file
{
- my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");
+ open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");
while (my $configline=<$config>) {
chomp($configline);
@@ -4536,46 +4615,50 @@ BEGIN {
$spareid{$configline}=1;
}
}
+ close($config);
}
# ------------------------------------------------------------ Read permissions
{
- my $config=Apache::File->new("$perlvar{'lonTabDir'}/roles.tab");
+ open(my $config,"<$perlvar{'lonTabDir'}/roles.tab");
while (my $configline=<$config>) {
- chomp($configline);
- if ($configline) {
- my ($role,$perm)=split(/ /,$configline);
- if ($perm ne '') { $pr{$role}=$perm; }
- }
+ chomp($configline);
+ if ($configline) {
+ my ($role,$perm)=split(/ /,$configline);
+ if ($perm ne '') { $pr{$role}=$perm; }
+ }
}
+ close($config);
}
# -------------------------------------------- Read plain texts for permissions
{
- my $config=Apache::File->new("$perlvar{'lonTabDir'}/rolesplain.tab");
+ open(my $config,"<$perlvar{'lonTabDir'}/rolesplain.tab");
while (my $configline=<$config>) {
- chomp($configline);
- if ($configline) {
- my ($short,$plain)=split(/:/,$configline);
- if ($plain ne '') { $prp{$short}=$plain; }
- }
+ chomp($configline);
+ if ($configline) {
+ my ($short,$plain)=split(/:/,$configline);
+ if ($plain ne '') { $prp{$short}=$plain; }
+ }
}
+ close($config);
}
# ---------------------------------------------------------- Read package table
{
- my $config=Apache::File->new("$perlvar{'lonTabDir'}/packages.tab");
+ open(my $config,"<$perlvar{'lonTabDir'}/packages.tab");
while (my $configline=<$config>) {
- chomp($configline);
- my ($short,$plain)=split(/:/,$configline);
- my ($pack,$name)=split(/\&/,$short);
- if ($plain ne '') {
- $packagetab{$pack.'&'.$name.'&name'}=$name;
- $packagetab{$short}=$plain;
- }
+ chomp($configline);
+ my ($short,$plain)=split(/:/,$configline);
+ my ($pack,$name)=split(/\&/,$short);
+ if ($plain ne '') {
+ $packagetab{$pack.'&'.$name.'&name'}=$name;
+ $packagetab{$short}=$plain;
+ }
}
+ close($config);
}
# ------------- set up temporary directory
@@ -5194,6 +5277,14 @@ dumps the complete (or key matching rege
=item *
+inc($namespace,$store,$udom,$uname) : increments $store in $namespace.
+$store can be a scalar, an array reference, or if the amount to be
+incremented is > 1, a hash reference.
+
+($udom and $uname are optional)
+
+=item *
+
put($namespace,$storehash,$udom,$uname) : stores hash in namesp
($udom and $uname are optional)