[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.1011 and 1.1014

version 1.1011, 2009/08/08 19:55:24 version 1.1014, 2009/08/11 11:33:52
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);
Line 5777  sub auto_courserequest_checks { Line 5878  sub auto_courserequest_checks {
     return %validations;       return %validations; 
 }  }
   
   sub auto_courserequest_validation {
       my ($dom,$details,$inststatuses,$message) = @_;
       return 'pending';
   }
   
 sub auto_validate_class_sec {  sub auto_validate_class_sec {
     my ($cdom,$cnum,$owners,$inst_class) = @_;      my ($cdom,$cnum,$owners,$inst_class) = @_;
     my $homeserver = &homeserver($cnum,$cdom);      my $homeserver = &homeserver($cnum,$cdom);
Line 6423  sub is_course { Line 6529  sub is_course {
     return 0;      return 0;
 }  }
   
   sub store_coursereq {
       my ($requestkey,$storehash) = @_;
       my $result;
       if ($requestkey =~ /^($match_domain)_($match_courseid)$/) {
           if (ref($storehash) eq 'HASH') {
               my $namespace = 'courserequests';
               my $uhome=&homeserver();
               if (($uhome eq '') || ($uhome eq 'no_host')) {
                   $result = 'error: no_host';
               } else {
                   $storehash->{'ip'} = $ENV{'REMOTE_ADDR'};
                   $storehash->{'host'} = $perlvar{'lonHostID'};
   
                   my $namevalue='';
                   foreach my $key (keys(%{$storehash})) {
                       $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
                   }
                   $namevalue=~s/\&$//;
                   $result =  &reply("store:$env{'user.domain'}:$env{'user.name'}:".
                                     "$namespace:$requestkey:$namevalue",$uhome);
               }
           } else {
               $result = 'error: data to store was not a hash reference'; 
           }
       } else {
           $result= 'error: invalid requestkey'; 
       }
       return $result;
   }
   
 # ---------------------------------------------------------- Assign Custom Role  # ---------------------------------------------------------- Assign Custom Role
   
 sub assigncustomrole {  sub assigncustomrole {
Line 7912  sub devalidate_title_cache { Line 8048  sub devalidate_title_cache {
     &devalidate_cache_new('title',$key);      &devalidate_cache_new('title',$key);
 }  }
   
   # ------------------------------------------------- Get the title of a course
   
   sub current_course_title {
       return $env{ 'course.' . $env{'request.course.id'} . '.description' };
   }
 # ------------------------------------------------- Get the title of a resource  # ------------------------------------------------- Get the title of a resource
   
 sub gettitle {  sub gettitle {
Removed from v.1.1011  
changed lines
  Added in v.1.1014

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