Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.191 and 1.193

version 1.191, 2001/12/18 20:59:38 version 1.193, 2001/12/22 21:46:02
Line 64 Line 64
 # 12/5 Guy Albertelli  # 12/5 Guy Albertelli
 # 12/6,12/7,12/12 Gerd Kortemeyer  # 12/6,12/7,12/12 Gerd Kortemeyer
 # 12/18 Scott Harrison  # 12/18 Scott Harrison
   # 12/21,12/22 Gerd Kortemeyer
 #  #
 ###  ###
   
Line 75  use LWP::UserAgent(); Line 76  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   use vars 
 qw(%perlvar %hostname %homecache %hostip %spareid %hostdom   qw(%perlvar %hostname %homecache %hostip %spareid %hostdom 
    %libserv %pr %prp %fe %fd %metacache %packagetab      %libserv %pr %prp %metacache %packagetab 
    %courselogs %accesshash $processmarker $dumpcount      %courselogs %accesshash $processmarker $dumpcount 
    %coursedombuf %coursehombuf);     %coursedombuf %coursehombuf);
 use IO::Socket;  use IO::Socket;
Line 708  sub courseacclog { Line 709  sub courseacclog {
     my $fnsymb=shift;      my $fnsymb=shift;
     unless ($ENV{'request.course.id'}) { return ''; }      unless ($ENV{'request.course.id'}) { return ''; }
     my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};      my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};
     if ($what=~/(problem|exam|quiz|assess|survey|form)$/) {      if ($fnsymb=~/(problem|exam|quiz|assess|survey|form)$/) {
         $what.=':POST';          $what.=':POST';
  foreach (keys %ENV) {   foreach (keys %ENV) {
             if ($_=~/^form\.(.*)/) {              if ($_=~/^form\.(.*)/) {
Line 1273  sub del { Line 1274  sub del {
 # -------------------------------------------------------------- dump interface  # -------------------------------------------------------------- dump interface
   
 sub dump {  sub dump {
    my ($namespace,$udomain,$uname)=@_;     my ($namespace,$udomain,$uname,$regexp)=@_;
    if (!$udomain) { $udomain=$ENV{'user.domain'}; }     if (!$udomain) { $udomain=$ENV{'user.domain'}; }
    if (!$uname) { $uname=$ENV{'user.name'}; }     if (!$uname) { $uname=$ENV{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);     my $uhome=&homeserver($uname,$udomain);
    my $rep=reply("dump:$udomain:$uname:$namespace",$uhome);     if ($regexp) {
          $regexp=&escape($regexp);
      } else {
          $regexp='.';
      }
      my $rep=reply("dump:$udomain:$uname:$namespace:$regexp",$uhome);
    my @pairs=split(/\&/,$rep);     my @pairs=split(/\&/,$rep);
    my %returnhash=();     my %returnhash=();
    foreach (@pairs) {     foreach (@pairs) {
Line 2627  BEGIN { Line 2633  BEGIN {
     }      }
 }  }
   
 # ------------------------------------------------------------- Read file types  
 {  
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");  
   
     while (my $configline=<$config>) {  
        next if ($configline =~ /^\#/);  
        chomp($configline);  
        my ($ending,$emb,@descr)=split(/\s+/,$configline);  
        if ($descr[0] ne '') {   
          $fe{$ending}=lc($emb);  
          $fd{$ending}=join(' ',@descr);  
        }  
     }  
 }  
   
 %metacache=();  %metacache=();
   
 $processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};  $processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};
Line 2869  namesp ($udomain and $uname are optional Line 2860  namesp ($udomain and $uname are optional
   
 =item *  =item *
   
 dump($namespace,$udomain,$uname) : dumps the complete namespace into a hash  dump($namespace,$udomain,$uname,$regexp) : 
 ($udomain and $uname are optional)  dumps the complete (or key matching regexp) namespace into a hash
   ($udomain, $uname and $regexp are optional)
   
 =item *  =item *
   

Removed from v.1.191  
changed lines
  Added in v.1.193


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