[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.612 and 1.618

version 1.612, 2005/03/17 21:18:12 version 1.618, 2005/03/31 15:55:47
Line 931  sub userenvironment { Line 931  sub userenvironment {
     return %returnhash;      return %returnhash;
 }  }
   
   # ---------------------------------------------------------- Get a studentphoto
   sub studentphoto {
       my ($udom,$unam,$ext) = @_;
       my $home=&Apache::lonnet::homeserver($unam,$udom);
       my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext",$home);
       my $url="/uploaded/$udom/$unam/internal/studentphoto.".$ext;
       if ($ret ne 'ok') {
    return '/adm/lonKaputt/lonlogo_broken.gif';
       }
       my $tokenurl=&Apache::lonnet::tokenwrapper($url);
       return $tokenurl;
   }
   
 # -------------------------------------------------------------------- New chat  # -------------------------------------------------------------------- New chat
   
 sub chatsend {  sub chatsend {
Line 1293  sub finishuserfileupload { Line 1306  sub finishuserfileupload {
     }      }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
     &Apache::lonnet::logthis("fetching ".$path.$file);  
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);      my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {      if ($fetchresult eq 'ok') {
 #  #
Line 1309  sub finishuserfileupload { Line 1321  sub finishuserfileupload {
 sub removeuploadedurl {  sub removeuploadedurl {
     my ($url)=@_;      my ($url)=@_;
     my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);      my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
     return &Apache::lonnet::removeuserfile($uname,$udom,$fname);      return &removeuserfile($uname,$udom,$fname);
 }  }
   
 sub removeuserfile {  sub removeuserfile {
Line 3716  sub is_locked { Line 3728  sub is_locked {
     my @check;      my @check;
     my $is_locked;      my $is_locked;
     push @check, $file_name;      push @check, $file_name;
     my %locked = &Apache::lonnet::get('file_permissions',\@check,      my %locked = &get('file_permissions',\@check,
                                         $ENV{'user.domain'},$ENV{'user.name'});        $ENV{'user.domain'},$ENV{'user.name'});
       my ($tmp)=keys(%locked);
       if ($tmp=~/^error:/) { undef(%locked); }
   
     if (ref($locked{$file_name}) eq 'ARRAY') {      if (ref($locked{$file_name}) eq 'ARRAY') {
         $is_locked = 'true';          $is_locked = 'true';
     } else {      } else {
Line 3729  sub is_locked { Line 3744  sub is_locked {
   
 sub mark_as_readonly {  sub mark_as_readonly {
     my ($domain,$user,$files,$what) = @_;      my ($domain,$user,$files,$what) = @_;
     my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
       my ($tmp)=keys(%current_permissions);
       if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     foreach my $file (@{$files}) {      foreach my $file (@{$files}) {
         push(@{$current_permissions{$file}},$what);          push(@{$current_permissions{$file}},$what);
     }      }
     &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);      &put('file_permissions',\%current_permissions,$domain,$user);
     return;      return;
 }  }
   
Line 3810  sub files_not_in_path { Line 3828  sub files_not_in_path {
   
 sub get_marked_as_readonly {  sub get_marked_as_readonly {
     my ($domain,$user,$what) = @_;      my ($domain,$user,$what) = @_;
     my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
       my ($tmp)=keys(%current_permissions);
       if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     my @readonly_files;      my @readonly_files;
     while (my ($file_name,$value) = each(%current_permissions)) {      while (my ($file_name,$value) = each(%current_permissions)) {
         if (ref($value) eq "ARRAY"){          if (ref($value) eq "ARRAY"){
Line 3829  sub get_marked_as_readonly { Line 3850  sub get_marked_as_readonly {
   
 sub get_marked_as_readonly_hash {  sub get_marked_as_readonly_hash {
     my ($domain,$user,$what) = @_;      my ($domain,$user,$what) = @_;
     my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
       my ($tmp)=keys(%current_permissions);
       if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     my %readonly_files;      my %readonly_files;
     while (my ($file_name,$value) = each(%current_permissions)) {      while (my ($file_name,$value) = each(%current_permissions)) {
         if (ref($value) eq "ARRAY"){          if (ref($value) eq "ARRAY"){
Line 3850  sub unmark_as_readonly { Line 3874  sub unmark_as_readonly {
     # unmarks all files locked by $what       # unmarks all files locked by $what 
     # for portfolio submissions, $what contains $crsid and $symb      # for portfolio submissions, $what contains $crsid and $symb
     my ($domain,$user,$what) = @_;      my ($domain,$user,$what) = @_;
     my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
     my @readonly_files = &Apache::lonnet::get_marked_as_readonly($domain,$user,$what);      my ($tmp)=keys(%current_permissions);
       if ($tmp=~/^error:/) { undef(%current_permissions); }
   
       my @readonly_files = &get_marked_as_readonly($domain,$user,$what);
     foreach my $file(@readonly_files){      foreach my $file(@readonly_files){
         my $current_locks = $current_permissions{$file};          my $current_locks = $current_permissions{$file};
         my @new_locks;          my @new_locks;
Line 3866  sub unmark_as_readonly { Line 3893  sub unmark_as_readonly {
                 $current_permissions{$file} = \@new_locks;                  $current_permissions{$file} = \@new_locks;
             } else {              } else {
                 push(@del_keys, $file);                  push(@del_keys, $file);
                 &Apache::lonnet::del('file_permissions',\@del_keys, $domain, $user);                  &del('file_permissions',\@del_keys, $domain, $user);
                 delete $current_permissions{$file};                  delete $current_permissions{$file};
             }              }
         }          }
     }      }
     &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);      &put('file_permissions',\%current_permissions,$domain,$user);
     return;      return;
 }  }
   
Line 4146  sub EXT { Line 4173  sub EXT {
     if ($realm eq 'user') {      if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource  # --------------------------------------------------------------- user.resource
  if ($space eq 'resource') {   if ($space eq 'resource') {
     if (defined($Apache::lonhomework::parsing_a_problem)) {      if (defined($Apache::lonhomework::parsing_a_problem) ||
    defined($Apache::lonhomework::parsing_a_task)) {
  return $Apache::lonhomework::history{$qualifierrest};   return $Apache::lonhomework::history{$qualifierrest};
     } else {      } else {
  my %restored;   my %restored;
Line 4470  sub metadata { Line 4498  sub metadata {
     } else {      } else {
  $metaentry{':packages'}=$package.$keyroot;   $metaentry{':packages'}=$package.$keyroot;
     }      }
     foreach (keys %packagetab) {      foreach (sort keys %packagetab) {
  my $part=$keyroot;   my $part=$keyroot;
  $part=~s/^\_//;   $part=~s/^\_//;
  if ($_=~/^\Q$package\E\&/ ||    if ($_=~/^\Q$package\E\&/ || 
Line 4687  sub gettitle { Line 4715  sub gettitle {
     if (!$title) { $title=(split('/',$urlsymb))[-1]; }          if (!$title) { $title=(split('/',$urlsymb))[-1]; }    
     return $title;      return $title;
 }  }
       
   sub get_slot {
       my ($which,$cnum,$cdom)=@_;
       if (!$cnum || !$cdom) {
    (undef,my $courseid)=&Apache::lonxml::whichuser();
    $cdom=$ENV{'course.'.$courseid.'.domain'};
    $cnum=$ENV{'course.'.$courseid.'.num'};
       }
       my %slotinfo=&get('slots',[$which],$cdom,$cnum);
       &Apache::lonhomework::showhash(%slotinfo);
       my ($tmp)=keys(%slotinfo);
       if ($tmp=~/^error:/) { return (); }
       if (ref($slotinfo{$which}) eq 'HASH') {
    return %{$slotinfo{$which}};
       }
       return $slotinfo{$which};
   }
 # ------------------------------------------------- Update symbolic store links  # ------------------------------------------------- Update symbolic store links
   
 sub symblist {  sub symblist {
Line 4980  sub validCODE { Line 5024  sub validCODE {
   
 sub getCODE {  sub getCODE {
     if (&validCODE($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }      if (&validCODE($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }
     if (defined($Apache::lonhomework::parsing_a_problem) &&      if ( (defined($Apache::lonhomework::parsing_a_problem) ||
  &validCODE($Apache::lonhomework::history{'resource.CODE'})) {    defined($Apache::lonhomework::parsing_a_task) ) &&
    &validCODE($Apache::lonhomework::history{'resource.CODE'})) {
  return $Apache::lonhomework::history{'resource.CODE'};   return $Apache::lonhomework::history{'resource.CODE'};
     }      }
     return undef;      return undef;
Removed from v.1.612  
changed lines
  Added in v.1.618

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