Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.816.2.3 and 1.817

version 1.816.2.3, 2007/01/12 21:36:42 version 1.817, 2006/12/28 20:09:10
Line 920  sub getsection { Line 920  sub getsection {
     # If there is a role which has expired, return it.      # If there is a role which has expired, return it.
     #      #
     $courseid = &courseid_to_courseurl($courseid);      $courseid = &courseid_to_courseurl($courseid);
     foreach my $line (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',      my %roleshash = &dump('roles',$udom,$unam,$courseid);
  &homeserver($unam,$udom)))) {      foreach my $key (keys(%roleshash)) {
         my ($key,$value)=split(/\=/,$line,2);  
         $key=&unescape($key);  
         next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);          next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);
         my $section=$1;          my $section=$1;
         if ($key eq $courseid.'_st') { $section=''; }          if ($key eq $courseid.'_st') { $section=''; }
         my ($dummy,$end,$start)=split(/\_/,&unescape($value));          my ($dummy,$end,$start)=split(/\_/,&unescape($roleshash{$key}));
         my $now=time;          my $now=time;
         if (defined($end) && $end && ($now > $end)) {          if (defined($end) && $end && ($now > $end)) {
             $Expired{$end}=$section;              $Expired{$end}=$section;
Line 3546  sub is_portfolio_url { Line 3544  sub is_portfolio_url {
   
 sub is_portfolio_file {  sub is_portfolio_file {
     my ($file) = @_;      my ($file) = @_;
     if (($file =~ /^portfolio/) || ($file =~ /^groups\/\w+\/portfolio/)) {      if (($file =~ /^portfolio/) || ($file =~ /^groups\/\w\/portfolio/)) {
         return 1;          return 1;
     }      }
     return;      return;
Line 3558  sub is_portfolio_file { Line 3556  sub is_portfolio_file {
 sub customaccess {  sub customaccess {
     my ($priv,$uri)=@_;      my ($priv,$uri)=@_;
     my ($urole,$urealm)=split(/\./,$env{'request.role'},2);      my ($urole,$urealm)=split(/\./,$env{'request.role'},2);
     my (undef,$udom,$ucrs,$usec)=split(/\//,$urealm);      my ($udom,$ucrs,$usec)=split(/\//,$urealm);
     $udom = &LONCAPA::clean_domain($udom);      $udom = &LONCAPA::clean_domain($udom);
     $ucrs = &LONCAPA::clean_username($ucrs);      $ucrs = &LONCAPA::clean_username($ucrs);
     my $access=0;      my $access=0;
Line 4098  sub log_query { Line 4096  sub log_query {
     return get_query_reply($queryid);      return get_query_reply($queryid);
 }  }
   
 # -------------------------- Update MySQL table for portfolio file  
   
 sub update_portfolio_table {  
     my ($uname,$udom,$file_name,$query,$group) = @_;  
     my $homeserver = &homeserver($uname,$udom);  
     my $queryid=  
         &reply("querysend:".$query.':'.&escape($uname.':'.$udom).':'.  
               &escape($file_name).':'.&escape($group),$homeserver);  
     my $reply = &get_query_reply($queryid);  
     return $reply;  
 }  
   
 # ------- Request retrieval of institutional classlists for course(s)  # ------- Request retrieval of institutional classlists for course(s)
   
 sub fetch_enrollment_query {  sub fetch_enrollment_query {
Line 4527  sub get_users_groups { Line 4513  sub get_users_groups {
         $grouplist = '';          $grouplist = '';
         my $courseurl = &courseid_to_courseurl($courseid);          my $courseurl = &courseid_to_courseurl($courseid);
         my %roleshash = &dump('roles',$udom,$uname,$courseurl);          my %roleshash = &dump('roles',$udom,$uname,$courseurl);
         my ($tmp) = keys(%roleshash);          my $access_end = $env{'course.'.$courseid.
         if ($tmp=~/^error:/) {                                '.default_enrollment_end_date'};
             &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom);          my $now = time;
         } else {          foreach my $key (keys(%roleshash)) {
             my $access_end = $env{'course.'.$courseid.              if ($key =~ /^\Q$courseurl\E\/(\w+)\_gr$/) {
                                   '.default_enrollment_end_date'};                  my $group = $1;
             my $now = time;                  if ($roleshash{$key} =~ /_(\d+)_(\d+)$/) {
             foreach my $key (keys(%roleshash)) {                      my $start = $2;
                 if ($key =~ /^\Q$courseurl\E\/(\w+)\_gr$/) {                      my $end = $1;
                     my $group = $1;                      if ($start == -1) { next; } # deleted from group
                     if ($roleshash{$key} =~ /_(\d+)_(\d+)$/) {                      if (($start!=0) && ($start>$now)) { next; }
                         my $start = $2;                      if (($end!=0) && ($end<$now)) {
                         my $end = $1;                          if ($access_end && $access_end < $now) {
                         if ($start == -1) { next; } # deleted from group                              if ($access_end - $end < 86400) {
                         if (($start!=0) && ($start>$now)) { next; }                                  push(@usersgroups,$group);
                         if (($end!=0) && ($end<$now)) {  
                             if ($access_end && $access_end < $now) {  
                                 if ($access_end - $end < 86400) {  
                                     push(@usersgroups,$group);  
                                 }  
                             }                              }
                             next;  
                         }                          }
                         push(@usersgroups,$group);                          next;
                     }                      }
                       push(@usersgroups,$group);
                 }                  }
             }              }
             @usersgroups = &sort_course_groups($courseid,@usersgroups);  
             $grouplist = join(':',@usersgroups);  
             &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);  
         }          }
           @usersgroups = &sort_course_groups($courseid,@usersgroups);
           $grouplist = join(':',@usersgroups);
           &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);
     }      }
     return @usersgroups;      return @usersgroups;
 }  }
Line 5278  sub modify_access_controls { Line 5259  sub modify_access_controls {
         #  remove lock          #  remove lock
         my @del_lock = ($file_name."\0".'locked_access_records');          my @del_lock = ($file_name."\0".'locked_access_records');
         my $dellockoutcome = &del('file_permissions',\@del_lock,$domain,$user);          my $dellockoutcome = &del('file_permissions',\@del_lock,$domain,$user);
         my ($file,$group);  
         if (&is_course($domain,$user)) {  
             ($group,$file) = split(/\//,$file_name,2);  
         } else {  
             $file = $file_name;  
         }  
         my $sqlresult =  
             &update_portfolio_table($user,$domain,$file,'portfolio_access',  
                                     $group);  
     } else {      } else {
         $outcome = "error: could not obtain lockfile\n";            $outcome = "error: could not obtain lockfile\n";  
     }      }

Removed from v.1.816.2.3  
changed lines
  Added in v.1.817


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