[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.794 and 1.799

version 1.794, 2006/10/17 05:56:46 version 1.799, 2006/10/23 21:22:44
Line 413  sub delenv { Line 413  sub delenv {
     return 'ok';      return 'ok';
 }  }
   
 =pod  
   
 =item * get_env_multiple($name)   
   
 gets $name from the %env hash, it seemlessly handles the cases where multiple  
 values may be defined and end up as an array ref.  
   
 returns an array of values  
   
 =cut  
   
 sub get_env_multiple {  sub get_env_multiple {
     my ($name) = @_;      my ($name) = @_;
     my @values;      my @values;
Line 547  sub compare_server_load { Line 536  sub compare_server_load {
 # --------------------------------------------- Try to change a user's password  # --------------------------------------------- Try to change a user's password
   
 sub changepass {  sub changepass {
     my ($uname,$udom,$currentpass,$newpass,$server)=@_;      my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_;
     $currentpass = &escape($currentpass);      $currentpass = &escape($currentpass);
     $newpass     = &escape($newpass);      $newpass     = &escape($newpass);
     my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass",      my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context",
        $server);         $server);
     if (! $answer) {      if (! $answer) {
  &logthis("No reply on password change request to $server ".   &logthis("No reply on password change request to $server ".
Line 1647  sub removeuploadedurl { Line 1636  sub removeuploadedurl {
 sub removeuserfile {  sub removeuserfile {
     my ($docuname,$docudom,$fname)=@_;      my ($docuname,$docudom,$fname)=@_;
     my $home=&homeserver($docuname,$docudom);      my $home=&homeserver($docuname,$docudom);
     return &reply("removeuserfile:$docudom/$docuname/$fname",$home);      my $result = &reply("removeuserfile:$docudom/$docuname/$fname",$home);
       if ($result eq 'ok') {
           if (($fname !~ /\.meta$/) && (&is_portfolio_file($fname))) {
               my $metafile = $fname.'.meta';
               my $metaresult = &removeuserfile($docuname,$docudom,$metafile); 
           }
       }
       return $result;
 }  }
   
 sub mkdiruserfile {  sub mkdiruserfile {
Line 1659  sub mkdiruserfile { Line 1655  sub mkdiruserfile {
 sub renameuserfile {  sub renameuserfile {
     my ($docuname,$docudom,$old,$new)=@_;      my ($docuname,$docudom,$old,$new)=@_;
     my $home=&homeserver($docuname,$docudom);      my $home=&homeserver($docuname,$docudom);
     return &reply("renameuserfile:$docudom:$docuname:".&escape("$old").':'.      my $result = &reply("renameuserfile:$docudom:$docuname:".
   &escape("$new"),$home);                          &escape("$old").':'.&escape("$new"),$home);
       if ($result eq 'ok') {
           if (($old !~ /\.meta$/) && (&is_portfolio_file($old))) {
               my $oldmeta = $old.'.meta';
               my $newmeta = $new.'.meta';
               my $metaresult = 
                   &renameuserfile($docuname,$docudom,$oldmeta,$newmeta);
           }
       }
       return $result;
 }  }
   
 # ------------------------------------------------------------------------- Log  # ------------------------------------------------------------------------- Log
Line 3455  sub is_portfolio_url { Line 3460  sub is_portfolio_url {
     return scalar(&parse_portfolio_url($url));      return scalar(&parse_portfolio_url($url));
 }  }
   
   sub is_portfolio_file {
       my ($file) = @_;
       if (($file =~ /^portfolio/) || ($file =~ /^groups\/\w+\/portfolio/)) {
           return 1;
       }
       return;
   }
   
   
 # ---------------------------------------------- Custom access rule evaluation  # ---------------------------------------------- Custom access rule evaluation
   
 sub customaccess {  sub customaccess {
Line 4277  sub auto_instcode_defaults { Line 4291  sub auto_instcode_defaults {
             foreach my $pair (split(/\&/,$response)) {              foreach my $pair (split(/\&/,$response)) {
                 my ($name,$value)=split(/\=/,$pair);                  my ($name,$value)=split(/\=/,$pair);
                 if ($name eq 'code_order') {                  if ($name eq 'code_order') {
                     $code_order = [split(/\&/,&unescape($value))];                      @{$code_order} = split(/\&/,&unescape($value));
                 } else {                  } else {
                     $$returnhash{&unescape($name)}=&unescape($value);                      $returnhash->{&unescape($name)}=&unescape($value);
                 }                  }
             }              }
         }          }
Line 5037  sub modify_access_controls { Line 5051  sub modify_access_controls {
             for (my $i=0; $i<$numnew; $i++) {              for (my $i=0; $i<$numnew; $i++) {
                 my $newkey = $newitems[$i];                  my $newkey = $newitems[$i];
                 my $newid = &Apache::loncommon::get_cgi_id();                  my $newid = &Apache::loncommon::get_cgi_id();
                 $newkey =~ s/^(\d+)/$newid/;                  if ($newkey =~ /^\d+:/) { 
                 $translation{$1} = $newid;                      $newkey =~ s/^(\d+)/$newid/;
                       $translation{$1} = $newid;
                   } elsif ($newkey =~ /^\d+_\d+_\d+:/) {
                       $newkey =~ s/^(\d+_\d+_\d+)/$newid/;
                       $translation{$1} = $newid;
                   }
                 $new_values{$file_name."\0".$newkey} =                   $new_values{$file_name."\0".$newkey} = 
                                           $$changes{'activate'}{$newitems[$i]};                                            $$changes{'activate'}{$newitems[$i]};
                 $new_control{$newkey} = $now;                  $new_control{$newkey} = $now;
Line 7554  B<delenv($regexp)>: removes all items fr Line 7573  B<delenv($regexp)>: removes all items fr
 environment file that matches the regular expression in $regexp. The  environment file that matches the regular expression in $regexp. The
 values are also delted from the current processes %env.  values are also delted from the current processes %env.
   
   =item * get_env_multiple($name) 
   
   gets $name from the %env hash, it seemlessly handles the cases where multiple
   values may be defined and end up as an array ref.
   
   returns an array of values
   
 =back  =back
   
 =head2 User Information  =head2 User Information
Removed from v.1.794  
changed lines
  Added in v.1.799

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