[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.443 and 1.449

version 1.443, 2003/11/10 20:27:32 version 1.449, 2003/11/12 20:32:04
Line 30 Line 30
 package Apache::lonnet;  package Apache::lonnet;
   
 use strict;  use strict;
 use Apache::File;  
 use LWP::UserAgent();  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   use vars 
Line 52  use Storable qw(lock_store lock_nstore l Line 51  use Storable qw(lock_store lock_nstore l
 use Time::HiRes();  use Time::HiRes();
 my $readit;  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  # --------------------------------------------------------------------- Logging
   
 sub logtouch {  sub logtouch {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     unless (-e "$execdir/logs/lonnet.log") {      unless (-e "$execdir/logs/lonnet.log") {
  my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");   open(my $fh,">>$execdir/logs/lonnet.log");
  close $fh;   close $fh;
     }      }
     my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];      my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];
Line 69  sub logthis { Line 91  sub logthis {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");      if (open(my $fh,">>$execdir/logs/lonnet.log")) {
     print $fh "$local ($$): $message\n";   print $fh "$local ($$): $message\n";
    close($fh);
       }
     return 1;      return 1;
 }  }
   
Line 79  sub logperm { Line 103  sub logperm {
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     my $fh=Apache::File->new(">>$execdir/logs/lonnet.perm.log");      if (open(my $fh,">>$execdir/logs/lonnet.perm.log")) {
     print $fh "$now:$message:$local\n";   print $fh "$now:$message:$local\n";
    close($fh);
       }
     return 1;      return 1;
 }  }
   
Line 132  sub reconlonc { Line 158  sub reconlonc {
     my $peerfile=shift;      my $peerfile=shift;
     &logthis("Trying to reconnect for $peerfile");      &logthis("Trying to reconnect for $peerfile");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";      my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
     if (my $fh=Apache::File->new("$loncfile")) {      if (open(my $fh,"<$loncfile")) {
  my $loncpid=<$fh>;   my $loncpid=<$fh>;
         chomp($loncpid);          chomp($loncpid);
         if (kill 0 => $loncpid) {          if (kill 0 => $loncpid) {
Line 180  sub critical { Line 206  sub critical {
       "$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server";        "$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server";
             $dumpcount++;              $dumpcount++;
             {              {
              my $dfh;   my $dfh;
              if ($dfh=Apache::File->new(">$dfilename")) {   if (open($dfh,">$dfilename")) {
                 print $dfh "$cmd\n";      print $dfh "$cmd\n"; 
      }      close($dfh);
    }
             }              }
             sleep 2;              sleep 2;
             my $wcmd='';              my $wcmd='';
             {              {
      my $dfh;   my $dfh;
              if ($dfh=Apache::File->new("$dfilename")) {   if (open($dfh,"<$dfilename")) {
                 $wcmd=<$dfh>;      $wcmd=<$dfh>; 
      }      close($dfh);
    }
             }              }
             chomp($wcmd);              chomp($wcmd);
             if ($wcmd eq $cmd) {              if ($wcmd eq $cmd) {
Line 230  sub transfer_profile_to_env { Line 258  sub transfer_profile_to_env {
     my ($lonidsdir,$handle)=@_;      my ($lonidsdir,$handle)=@_;
     my @profile;      my @profile;
     {      {
  my $idf=Apache::File->new("$lonidsdir/$handle.id");   open(my $idf,"$lonidsdir/$handle.id");
  flock($idf,LOCK_SH);   flock($idf,LOCK_SH);
  @profile=<$idf>;   @profile=<$idf>;
  $idf->close();   close($idf);
     }      }
     my $envi;      my $envi;
     my %Remove;      my %Remove;
Line 247  sub transfer_profile_to_env { Line 275  sub transfer_profile_to_env {
             }              }
         }          }
     }      }
       $ENV{'user.environment'} = "$lonidsdir/$handle.id";
     foreach my $expired_key (keys(%Remove)) {      foreach my $expired_key (keys(%Remove)) {
         &delenv($expired_key);          &delenv($expired_key);
     }      }
     $ENV{'user.environment'} = "$lonidsdir/$handle.id";  
 }  }
   
 # ---------------------------------------------------------- Append Environment  # ---------------------------------------------------------- Append Environment
Line 269  sub appenv { Line 297  sub appenv {
     }      }
   
     my $lockfh;      my $lockfh;
     unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {      unless (open($lockfh,"$ENV{'user.environment'}")) {
        return 'error: '.$!;   return 'error: '.$!;
     }      }
     unless (flock($lockfh,LOCK_EX)) {      unless (flock($lockfh,LOCK_EX)) {
          &logthis("<font color=blue>WARNING: ".           &logthis("<font color=blue>WARNING: ".
                   'Could not obtain exclusive lock in appenv: '.$!);                    'Could not obtain exclusive lock in appenv: '.$!);
          $lockfh->close();           close($lockfh);
          return 'error: '.$!;           return 'error: '.$!;
     }      }
   
     my @oldenv;      my @oldenv;
     {      {
      my $fh;   my $fh;
      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {   unless (open($fh,"$ENV{'user.environment'}")) {
  return 'error: '.$!;      return 'error: '.$!;
      }   }
      @oldenv=<$fh>;   @oldenv=<$fh>;
      $fh->close();   close($fh);
     }      }
     for (my $i=0; $i<=$#oldenv; $i++) {      for (my $i=0; $i<=$#oldenv; $i++) {
         chomp($oldenv[$i]);          chomp($oldenv[$i]);
         if ($oldenv[$i] ne '') {          if ($oldenv[$i] ne '') {
            my ($name,$value)=split(/=/,$oldenv[$i]);      my ($name,$value)=split(/=/,$oldenv[$i]);
            unless (defined($newenv{$name})) {      unless (defined($newenv{$name})) {
       $newenv{$name}=$value;   $newenv{$name}=$value;
    }      }
         }          }
     }      }
     {      {
      my $fh;   my $fh;
      unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {   unless (open($fh,">$ENV{'user.environment'}")) {
  return 'error';      return 'error';
      }   }
      my $newname;   my $newname;
      foreach $newname (keys %newenv) {   foreach $newname (keys %newenv) {
  print $fh "$newname=$newenv{$newname}\n";      print $fh "$newname=$newenv{$newname}\n";
      }   }
      $fh->close();   close($fh);
     }      }
   
     $lockfh->close();      close($lockfh);
     return 'ok';      return 'ok';
 }  }
 # ----------------------------------------------------- Delete from Environment  # ----------------------------------------------------- Delete from Environment
Line 324  sub delenv { Line 352  sub delenv {
     }      }
     my @oldenv;      my @oldenv;
     {      {
      my $fh;   my $fh;
      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {   unless (open($fh,"$ENV{'user.environment'}")) {
  return 'error';      return 'error';
      }   }
      unless (flock($fh,LOCK_SH)) {   unless (flock($fh,LOCK_SH)) {
          &logthis("<font color=blue>WARNING: ".      &logthis("<font color=blue>WARNING: ".
                   'Could not obtain shared lock in delenv: '.$!);       'Could not obtain shared lock in delenv: '.$!);
          $fh->close();      close($fh);
          return 'error: '.$!;      return 'error: '.$!;
      }   }
      @oldenv=<$fh>;   @oldenv=<$fh>;
      $fh->close();   close($fh);
     }      }
     {      {
      my $fh;   my $fh;
      unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {   unless (open($fh,">$ENV{'user.environment'}")) {
  return 'error';      return 'error';
      }   }
      unless (flock($fh,LOCK_EX)) {   unless (flock($fh,LOCK_EX)) {
          &logthis("<font color=blue>WARNING: ".      &logthis("<font color=blue>WARNING: ".
                   'Could not obtain exclusive lock in delenv: '.$!);       'Could not obtain exclusive lock in delenv: '.$!);
          $fh->close();      close($fh);
          return 'error: '.$!;      return 'error: '.$!;
      }   }
      foreach (@oldenv) {   foreach (@oldenv) {
  unless ($_=~/^$delthis/) { print $fh $_; }      unless ($_=~/^$delthis/) { print $fh $_; }
      }   }
      $fh->close();   close($fh);
     }      }
     return 'ok';      return 'ok';
 }  }
Line 387  sub overloaderror { Line 415  sub overloaderror {
     unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }      unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
     my $loadavg;      my $loadavg;
     if ($checkserver eq $perlvar{'lonHostID'}) {      if ($checkserver eq $perlvar{'lonHostID'}) {
        my $loadfile=Apache::File->new('/proc/loadavg');         open(my $loadfile,'/proc/loadavg');
        $loadavg=<$loadfile>;         $loadavg=<$loadfile>;
        $loadavg =~ s/\s.*//g;         $loadavg =~ s/\s.*//g;
        $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};         $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
          close($loadfile);
     } else {      } else {
        $loadavg=&reply('load',$checkserver);         $loadavg=&reply('load',$checkserver);
     }      }
Line 895  EVALBLOCK Line 924  EVALBLOCK
  }   }
     } else {      } else {
  if (-e $filename) {   if (-e $filename) {
     &logthis("Unable to tie hash (save cache item): $name");      &logthis("Unable to tie hash (save cache item): $name ($!)");
     unlink($filename);      unlink($filename);
  }   }
     }      }
Line 939  EVALBLOCK Line 968  EVALBLOCK
  }           }        
     } else {      } else {
  if (-e $filename) {   if (-e $filename) {
     &logthis("Unable to tie hash (load cache item): $name");      &logthis("Unable to tie hash (load cache item): $name ($!)");
     unlink($filename);      unlink($filename);
  }   }
     }      }
Line 1229  sub finishuserfileupload { Line 1258  sub finishuserfileupload {
     }      }
 # Save the file  # Save the file
     {      {
        my $fh=Apache::File->new('>'.$filepath.'/'.$fname);         open(my $fh,'>'.$filepath.'/'.$fname);
        print $fh $ENV{'form.'.$formname};         print $fh $ENV{'form.'.$formname};
          close($fh);
     }      }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
Line 1304  sub flushcourselogs { Line 1334  sub flushcourselogs {
 # File accesses  # File accesses
 # Writes to the dynamic metadata of resources to get hit counts, etc.  # Writes to the dynamic metadata of resources to get hit counts, etc.
 #  #
     foreach (keys %accesshash) {      foreach my $entry (keys(%accesshash)) {
         my $entry=$_;          my ($dom,$name,undef,$type)=($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
         $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;  
         my %temphash=($entry => $accesshash{$entry});          my %temphash=($entry => $accesshash{$entry});
         if (&Apache::lonnet::put('nohist_resevaldata',\%temphash,$1,$2) eq 'ok') {          if ($type eq 'count'){
     delete $accesshash{$entry};              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.
                   if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                       delete $accesshash{$entry};
                   }
               }
    &logthis('incrementing '.$entry.' by '.$accesshash{$entry}.' result is '.$result);
           } else {
               if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                   delete $accesshash{$entry};
               }
         }          }
     }      }
 #  #
Line 1454  sub postannounce { Line 1496  sub postannounce {
 }  }
   
 sub getannounce {  sub getannounce {
     if (my $fh=Apache::File->new($perlvar{'lonDocRoot'}.'/announcement.txt')) {  
       if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {
  my $announcement='';   my $announcement='';
  while (<$fh>) { $announcement .=$_; }   while (<$fh>) { $announcement .=$_; }
  $fh->close();   close($fh);
  if ($announcement=~/\w/) {    if ($announcement=~/\w/) { 
     return       return 
    '<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.     '<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.
Line 1970  sub store { Line 2013  sub store {
        }          } 
     }      }
     if (!$home) { $home=$ENV{'user.home'}; }      if (!$home) { $home=$ENV{'user.home'}; }
   
       $$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
       $$storehash{'host'}=$perlvar{'lonHostID'};
   
     my $namevalue='';      my $namevalue='';
     foreach (keys %$storehash) {      foreach (keys %$storehash) {
         $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
Line 2003  sub cstore { Line 2050  sub cstore {
     }      }
     if (!$home) { $home=$ENV{'user.home'}; }      if (!$home) { $home=$ENV{'user.home'}; }
   
       $$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
       $$storehash{'host'}=$perlvar{'lonHostID'};
   
     my $namevalue='';      my $namevalue='';
     foreach (keys %$storehash) {      foreach (keys %$storehash) {
         $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
Line 2337  sub convert_dump_to_currentdump{ Line 2387  sub convert_dump_to_currentdump{
     return \%returnhash;      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  # --------------------------------------------------------------- put interface
   
 sub put {  sub put {
Line 2837  sub get_query_reply { Line 2911  sub get_query_reply {
     for (1..100) {      for (1..100) {
  sleep 2;   sleep 2;
         if (-e $replyfile.'.end') {          if (-e $replyfile.'.end') {
     if (my $fh=Apache::File->new($replyfile)) {      if (open(my $fh,$replyfile)) {
                $reply.=<$fh>;                 $reply.=<$fh>;
                $fh->close;                 close($fh);
    } else { return 'error: reply_file_error'; }     } else { return 'error: reply_file_error'; }
            return &unescape($reply);             return &unescape($reply);
  }   }
Line 4069  sub fixversion { Line 4143  sub fixversion {
     &GDBM_READER(),0640)) {      &GDBM_READER(),0640)) {
   if ($bighash{'version_'.$uri}) {    if ($bighash{'version_'.$uri}) {
      my $version=$bighash{'version_'.$uri};       my $version=$bighash{'version_'.$uri};
      unless ($version eq 'mostrecent') {       unless (($version eq 'mostrecent') || 
       ($version==&getversion($uri))) {
   $uri=~s/\.(\w+)$/\.$version\.$1/;    $uri=~s/\.(\w+)$/\.$version\.$1/;
      }       }
   }    }
Line 4329  sub getfile { Line 4404  sub getfile {
  } else { # normal file from res space   } else { # normal file from res space
   &repcopy($file);    &repcopy($file);
   if (! -e $file ) { return -1; };    if (! -e $file ) { return -1; };
   my $fh=Apache::File->new($file);    my $fh;
     open($fh,"<$file");
   my $a='';    my $a='';
   while (<$fh>) { $a .=$_; }    while (<$fh>) { $a .=$_; }
   return $a;    return $a;
Line 4445  BEGIN { Line 4521  BEGIN {
 # ----------------------------------- Read loncapa.conf and loncapa_apache.conf  # ----------------------------------- Read loncapa.conf and loncapa_apache.conf
     unless ($readit) {      unless ($readit) {
 {  {
     my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf");      open(my $config,"</etc/httpd/conf/loncapa.conf");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
         if ($configline =~ /^[^\#]*PerlSetVar/) {          if ($configline =~ /^[^\#]*PerlSetVar/) {
Line 4454  BEGIN { Line 4530  BEGIN {
            $perlvar{$varname}=$varvalue;             $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>) {      while (my $configline=<$config>) {
         if ($configline =~ /^[^\#]*PerlSetVar/) {          if ($configline =~ /^[^\#]*PerlSetVar/) {
Line 4465  BEGIN { Line 4542  BEGIN {
            $perlvar{$varname}=$varvalue;             $perlvar{$varname}=$varvalue;
         }          }
     }      }
       close($config);
 }  }
   
 # ------------------------------------------------------------ Read domain file  # ------------------------------------------------------------ Read domain file
 {  {
     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.  
                             '/domain.tab');  
     %domaindescription = ();      %domaindescription = ();
     %domain_auth_def = ();      %domain_auth_def = ();
     %domain_auth_arg_def = ();      %domain_auth_arg_def = ();
     if ($fh) {      my $fh;
       if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
        while (<$fh>) {         while (<$fh>) {
            next if (/^(\#|\s*$)/);             next if (/^(\#|\s*$)/);
 #           next if /^\#/;  #           next if /^\#/;
Line 4489  BEGIN { Line 4566  BEGIN {
    $domain_longi{$domain}=$longi;     $domain_longi{$domain}=$longi;
    $domain_lati{$domain}=$lati;     $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} );  #          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
        }   }
     }      }
       close ($fh);
 }  }
   
   
 # ------------------------------------------------------------- Read hosts file  # ------------------------------------------------------------- Read hosts file
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");      open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        next if ($configline =~ /^(\#|\s*$)/);         next if ($configline =~ /^(\#|\s*$)/);
Line 4516  BEGIN { Line 4594  BEGIN {
  }   }
        }         }
     }      }
       close($config);
 }  }
   
 # ------------------------------------------------------ Read spare server file  # ------------------------------------------------------ Read spare server file
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");      open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);         chomp($configline);
Line 4528  BEGIN { Line 4607  BEGIN {
           $spareid{$configline}=1;            $spareid{$configline}=1;
        }         }
     }      }
       close($config);
 }  }
 # ------------------------------------------------------------ Read permissions  # ------------------------------------------------------------ Read permissions
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/roles.tab");      open(my $config,"<$perlvar{'lonTabDir'}/roles.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);   chomp($configline);
       if ($configline) {   if ($configline) {
        my ($role,$perm)=split(/ /,$configline);      my ($role,$perm)=split(/ /,$configline);
        if ($perm ne '') { $pr{$role}=$perm; }      if ($perm ne '') { $pr{$role}=$perm; }
       }   }
     }      }
       close($config);
 }  }
   
 # -------------------------------------------- Read plain texts for permissions  # -------------------------------------------- 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>) {      while (my $configline=<$config>) {
        chomp($configline);   chomp($configline);
       if ($configline) {   if ($configline) {
        my ($short,$plain)=split(/:/,$configline);      my ($short,$plain)=split(/:/,$configline);
        if ($plain ne '') { $prp{$short}=$plain; }      if ($plain ne '') { $prp{$short}=$plain; }
       }   }
     }      }
       close($config);
 }  }
   
 # ---------------------------------------------------------- Read package table  # ---------------------------------------------------------- Read package table
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/packages.tab");      open(my $config,"<$perlvar{'lonTabDir'}/packages.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);   chomp($configline);
        my ($short,$plain)=split(/:/,$configline);   my ($short,$plain)=split(/:/,$configline);
        my ($pack,$name)=split(/\&/,$short);   my ($pack,$name)=split(/\&/,$short);
        if ($plain ne '') {   if ($plain ne '') {
           $packagetab{$pack.'&'.$name.'&name'}=$name;       $packagetab{$pack.'&'.$name.'&name'}=$name; 
           $packagetab{$short}=$plain;       $packagetab{$short}=$plain; 
        }   }
     }      }
       close($config);
 }  }
   
 # ------------- set up temporary directory  # ------------- set up temporary directory
Line 5186  dumps the complete (or key matching rege Line 5269  dumps the complete (or key matching rege
   
 =item *  =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  put($namespace,$storehash,$udom,$uname) : stores hash in namesp
 ($udom and $uname are optional)  ($udom and $uname are optional)
   
Removed from v.1.443  
changed lines
  Added in v.1.449

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