Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1011 and 1.1012

version 1.1011, 2009/08/08 19:55:24 version 1.1012, 2009/08/10 23:32:35
Line 958  sub idput { Line 958  sub idput {
     }      }
 }  }
   
   # ------------------------------------------------ dump from domain db files
   
   sub dump_dom {
       my ($namespace,$udom,$uhome,$regexp,$range)=@_;
       if (!$udom) {
           $udom=$env{'user.domain'};
           if (defined(&domain($udom,'primary'))) {
               $uhome=&domain($udom,'primary');
           } else {
               undef($uhome);
           }
       } else {
           if (!$uhome) {
               if (defined(&domain($udom,'primary'))) {
                   $uhome=&domain($udom,'primary');
               }
           }
       }
       my %returnhash;
       if ($udom && $uhome && ($uhome ne 'no_host')) {
           if ($regexp) {
               $regexp=&escape($regexp);
           } else {
               $regexp='.';
           }
           my $rep=&reply("dumpdom:$udom:$namespace:$regexp:$range",$uhome);
           my @pairs=split(/\&/,$rep);
           foreach my $item (@pairs) {
               my ($key,$value)=split(/=/,$item,2);
               $key = &unescape($key);
               next if ($key =~ /^error: 2 /);
               $returnhash{$key}=&thaw_unescape($value);
           }
       }
       return %returnhash;
   }
   
 # ------------------------------------------- get items from domain db files     # ------------------------------------------- get items from domain db files   
   
 sub get_dom {  sub get_dom {
Line 1032  sub put_dom { Line 1069  sub put_dom {
     }      }
 }  }
   
   # -------------------------------------- newput for items in domain db files
   
   sub newput_dom {
       my ($namespace,$storehash,$udom,$uhome) = @_;
       my $result;
       if (!$udom) {
           $udom=$env{'user.domain'};
           if (defined(&domain($udom,'primary'))) {
               $uhome=&domain($udom,'primary');
           } else {
               undef($uhome);
           }
       } else {
           if (!$uhome) {
               if (defined(&domain($udom,'primary'))) {
                   $uhome=&domain($udom,'primary');
               }
           }
       }
       if ($udom && $uhome && ($uhome ne 'no_host')) {
           my $items='';
           if (ref($storehash) eq 'HASH') {
               foreach my $key (keys(%$storehash)) {
                   $items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
               }
               $items=~s/\&$//;
               $result = &reply("newputdom:$udom:$namespace:$items",$uhome);
           }
       } else {
           &logthis("put_dom failed - no homeserver and/or domain");
       }
       return $result;
   }
   
   sub del_dom {
       my ($namespace,$storearr,$udom,$uhome)=@_;
       if (ref($storearr) eq 'ARRAY') {
           my $items='';
           foreach my $item (@$storearr) {
               $items.=&escape($item).'&';
           }
           $items=~s/\&$//;
           if (!$udom) {
               $udom=$env{'user.domain'};
               if (defined(&domain($udom,'primary'))) {
                   $uhome=&domain($udom,'primary');
               } else {
                   undef($uhome);
               }
           } else {
               if (!$uhome) {
                   if (defined(&domain($udom,'primary'))) {
                       $uhome=&domain($udom,'primary');
                   }
               }
           }
           if ($udom && $uhome && ($uhome ne 'no_host')) {
               return &reply("deldom:$udom:$namespace:$items",$uhome);
           } else {
               &logthis("del_dom failed - no homeserver and/or domain");
           }
       }
   }
   
 sub retrieve_inst_usertypes {  sub retrieve_inst_usertypes {
     my ($udom) = @_;      my ($udom) = @_;
     my (%returnhash,@order);      my (%returnhash,@order);

Removed from v.1.1011  
changed lines
  Added in v.1.1012


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