Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.517 and 1.522

version 1.517, 2004/06/30 12:33:47 version 1.522, 2004/07/16 17:56:01
Line 1600  sub getannounce { Line 1600  sub getannounce {
  if ($announcement=~/\w/) {    if ($announcement=~/\w/) { 
     return       return 
    '<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.     '<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.
    '<tr><td bgcolor="#FFFFFF"><pre>'.$announcement.'</pre></td></tr></table>';      '<tr><td bgcolor="#FFFFFF"><tt>'.$announcement.'</tt></td></tr></table>'; 
  } else {   } else {
     return '';      return '';
  }   }
Line 3203  sub auto_create_password { Line 3203  sub auto_create_password {
     return ($authparam,$create_passwd,$authchk);      return ($authparam,$create_passwd,$authchk);
 }  }
   
   sub auto_instcode_format {
       my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_;
       my $courses = '';
       my $homeserver;
       if ($caller eq 'global') {
           $homeserver = $perlvar{'lonHostID'};
       } else {
           $homeserver = &homeserver($caller,$codedom);
       }
       my $host=$hostname{$homeserver};
       foreach (keys %{$instcodes}) {
           $courses .= &escape($_).'='.&escape($$instcodes{$_}).'&';
       }
       chop($courses);
       my $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$homeserver);
       unless ($response =~ /(con_lost|error|no_such_host|refused)/) {
           my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = split/:/,$response;
           %{$codes} = &str2hash($codes_str);
           @{$codetitles} = &str2array($codetitles_str);
           %{$cat_titles} = &str2hash($cat_titles_str);
           %{$cat_order} = &str2hash($cat_order_str);
           return 'ok';
       }
       return $response;
   }
   
 # ------------------------------------------------------------------ Plain Text  # ------------------------------------------------------------------ Plain Text
   
 sub plaintext {  sub plaintext {
Line 3585  sub revokecustomrole { Line 3611  sub revokecustomrole {
   
   
 # ------------------------------------------------------------ Portfolio Director Lister  # ------------------------------------------------------------ Portfolio Director Lister
   # returns listing of contents of user's /userfiles/portfolio/ directory
   # 
   
 sub portfoliolist {  sub portfoliolist {
 #FIXME us the ls: command instead please      my ($currentPath, $currentFile) = @_;
 #FIXME uhome should never be an argument to any lonnet functions      my ($udom, $uname, $portfolioRoot);
     # returns listing of contents of user's /userfiles/portfolio/ directory  
     #   
     my ($udom,$uname,$uhome);  
     $uname=$ENV{'user.name'};      $uname=$ENV{'user.name'};
     $udom=$ENV{'user.domain'};      $udom=$ENV{'user.domain'};
     $uhome=$ENV{'user.home'};      # really should interrogate the system for home directory information, but . . .
     my $listing = &reply('portls:'.$uname.':'.$udom, $uhome);      $portfolioRoot = '/home/httpd/lonUsers/'.$udom.'/';
       $uname =~ /^(.?)(.?)(.?)/;
       $portfolioRoot = $portfolioRoot.$1.'/'.$2.'/'.$3.'/'.$uname.'/userfiles/portfolio';
       my $listing = &reply('ls:'.$portfolioRoot.$currentPath, &homeserver($uname,$udom));
     return $listing;      return $listing;
 }  }
   
Line 4899  sub getfile { Line 4928  sub getfile {
  }   }
     } else {      } else {
  $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);   $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);
  &logthis("return is $lwpresp");  
  if ($lwpresp ne 'ok') {   if ($lwpresp ne 'ok') {
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request('GET',&tokenwrapper($file));      my $request=new HTTP::Request('GET',&tokenwrapper($file));
Line 4913  sub getfile { Line 4941  sub getfile {
  my @parts = ($cdom,$cnum);    my @parts = ($cdom,$cnum); 
  if ($filename =~ m|^(.+)/[^/]+$|) {   if ($filename =~ m|^(.+)/[^/]+$|) {
     push @parts, split(/\//,$1);      push @parts, split(/\//,$1);
     }   }
  foreach my $part (@parts) {   foreach my $part (@parts) {
     $path .= '/'.$part;      $path .= '/'.$part;
     if (!-e $path) {      if (!-e $path) {

Removed from v.1.517  
changed lines
  Added in v.1.522


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