[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.294 and 1.300

version 1.294, 2002/10/09 17:24:06 version 1.300, 2002/11/12 22:23:37
Line 77  use Apache::File; Line 77  use Apache::File;
 use LWP::UserAgent();  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   use vars 
 qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom   qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
    %libserv %pr %prp %metacache %packagetab      %libserv %pr %prp %metacache %packagetab 
    %courselogs %accesshash $processmarker $dumpcount      %courselogs %accesshash $processmarker $dumpcount 
    %coursedombuf %coursehombuf %courseresdatacache %domaindescription);     %coursedombuf %coursehombuf %courseresdatacache %domaindescription);
Line 593  sub idput { Line 593  sub idput {
   
 # ------------------------------------- Find the section of student in a course  # ------------------------------------- Find the section of student in a course
   
   sub getsection {
       my ($udom,$unam,$courseid)=@_;
       $courseid=~s/\_/\//g;
       $courseid=~s/^(\w)/\/$1/;
       my %Pending; 
       my %Expired;
       #
       # Each role can either have not started yet (pending), be active, 
       #    or have expired.
       #
       # If there is an active role, we are done.
       #
       # If there is more than one role which has not started yet, 
       #     choose the one which will start sooner
       # If there is one role which has not started yet, return it.
       #
       # If there is more than one expired role, choose the one which ended last.
       # If there is a role which has expired, return it.
       #
       foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
                           &homeserver($unam,$udom)))) {
           my ($key,$value)=split(/\=/,$_);
           $key=&unescape($key);
           next if ($key !~/^$courseid(?:\/)*(\w+)*\_st$/);
           my $section=$1;
           if ($key eq $courseid.'_st') { $section=''; }
           my ($dummy,$end,$start)=split(/\_/,&unescape($value));
           my $now=time;
           if (defined($end) && ($now > $end)) {
               $Expired{$end}=$section;
               next;
           }
           if (defined($start) && ($now < $start)) {
               $Pending{$start}=$section;
               next;
           }
           return $section;
       }
       #
       # Presumedly there will be few matching roles from the above
       # loop and the sorting time will be negligible.
       if (scalar(keys(%Pending))) {
           my ($time) = sort {$a <=> $b} keys(%Pending);
           return $Pending{$time};
       } 
       if (scalar(keys(%Expired))) {
           my @sorted = sort {$a <=> $b} keys(%Expired);
           my $time = pop(@sorted);
           return $Expired{$time};
       }
       return '-1';
   }
   
 sub usection {  sub usection {
     my ($udom,$unam,$courseid)=@_;      my ($udom,$unam,$courseid)=@_;
     $courseid=~s/\_/\//g;      $courseid=~s/\_/\//g;
Line 840  sub finishuserfileupload { Line 893  sub finishuserfileupload {
     }      }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
     if       
 (&reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome) eq 'ok')       my $fetchresult= 
     {   &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome);
       if ($fetchresult eq 'ok') {
 #  #
 # Return the URL to it  # Return the URL to it
         return '/uploaded/'.$path.$fname;          return '/uploaded/'.$path.$fname;
     } else {      } else {
           &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$fname.
            ' to host '.$docuhome.': '.$fetchresult);
         return '/adm/notfound.html';          return '/adm/notfound.html';
     }          }    
 }  }
Line 1047  sub devalidate { Line 1103  sub devalidate {
     if ($cid) {      if ($cid) {
  my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';   my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';
         my $status=          my $status=
     &del('nohist_calculatedsheet',      &del('nohist_calculatedsheets',
  [$key.'studentcalc'],   [$key.'studentcalc'],
  $ENV{'course.'.$cid.'.domain'},   $ENV{'course.'.$cid.'.domain'},
  $ENV{'course.'.$cid.'.num'})   $ENV{'course.'.$cid.'.num'})
Line 2317  sub modifystudent { Line 2373  sub modifystudent {
  ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,   ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,
          $desiredhome);           $desiredhome);
     unless ($reply eq 'ok') { return $reply; }      unless ($reply eq 'ok') { return $reply; }
       # This will cause &modify_student_enrollment to get the uid from the
       # students environment
       $uid = undef if (!$forceid);
       $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,
                                           $last,$gene,$usec,$end,$start);
       return $reply;
   }
   
   sub modify_student_enrollment {
       my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start) = @_;
       # Get the course id from the environment
       my $cid='';
       unless ($cid=$ENV{'request.course.id'}) {
    return 'not_in_class';
       }
       # Make sure the user exists
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom);
     if (($uhome eq '') || ($uhome eq 'no_host')) {       if (($uhome eq '') || ($uhome eq 'no_host')) { 
  return 'error: no such user';   return 'error: no such user';
     }      }
 # -------------------------------------------------- Add student to course list      #
     if ($first eq '' || $last eq '' || $uid eq '') {      # Get student data if we were not given enough information
       if (!defined($first)  || $first  eq '' || 
           !defined($last)   || $last   eq '' || 
           !defined($uid)    || $uid    eq '' || 
           !defined($middle) || $middle eq '' || 
           !defined($gene)   || $gene   eq '') {
         # They did not supply us with enough data to enroll the student, so          # They did not supply us with enough data to enroll the student, so
         # we need to pick up more information.          # we need to pick up more information.
         my %tmp = dump('environment',$udom,$uname,          my %tmp = &get('environment',
                        ['firstname','middlename','lastname', 'generation','id']                         ['firstname','middlename','lastname', 'generation','id']
                        );                         ,$udom,$uname);
   
           foreach (keys(%tmp)) {
               &logthis("key $_ = ".$tmp{$_});
           }
         $first  = $tmp{'firstname'}  if (!defined($first)  || $first  eq '');          $first  = $tmp{'firstname'}  if (!defined($first)  || $first  eq '');
         $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq '');          $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq '');
         $last   = $tmp{'lastname'}   if (!defined($last)   || $last eq '');          $last   = $tmp{'lastname'}   if (!defined($last)   || $last eq '');
         $gene   = $tmp{'genename'}   if (!defined($gene)   || $gene eq '');          $gene   = $tmp{'generation'} if (!defined($gene)   || $gene eq '');
         $uid    = $tmp{'id'}         if (!defined($uid)    || $uid  eq '');          $uid    = $tmp{'id'}         if (!defined($uid)    || $uid  eq '');
     }      }
     my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene,      my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene,
                                                            $first,$middle);                                                             $first,$middle);
     $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.      my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
               $ENV{'course.'.$cid.'.num'}.':classlist:'.                $ENV{'course.'.$cid.'.num'}.':classlist:'.
                       &escape($uname.':'.$udom).'='.                        &escape($uname.':'.$udom).'='.
                       &escape(join(':',$end,$start,$uid,$usec,$fullname)),                        &escape(join(':',$end,$start,$uid,$usec,$fullname)),
Line 2344  sub modifystudent { Line 2425  sub modifystudent {
     unless (($reply eq 'ok') || ($reply eq 'delayed')) {      unless (($reply eq 'ok') || ($reply eq 'delayed')) {
  return 'error: '.$reply;   return 'error: '.$reply;
     }      }
 # ---------------------------------------------------- Add student role to user      # Add student role to user
     my $uurl='/'.$cid;      my $uurl='/'.$cid;
     $uurl=~s/\_/\//g;      $uurl=~s/\_/\//g;
     if ($usec) {      if ($usec) {
Line 3367  BEGIN { Line 3448  BEGIN {
  $hostname{$id}=$name;   $hostname{$id}=$name;
  $hostdom{$id}=$domain;   $hostdom{$id}=$domain;
  $hostip{$id}=$ip;   $hostip{$id}=$ip;
    $iphost{$ip}=$id;
  if ($domdescr) { $domaindescription{$domain}=$domdescr; }   if ($domdescr) { $domaindescription{$domain}=$domdescr; }
  if ($role eq 'library') { $libserv{$id}=$name; }   if ($role eq 'library') { $libserv{$id}=$name; }
        } else {         } else {
Line 3654  The course id is resolved based on the c Line 3736  The course id is resolved based on the c
 This means the envoking user must be a course coordinator or otherwise  This means the envoking user must be a course coordinator or otherwise
 associated with a course.  associated with a course.
   
 This call is essentially a wrapper for lonnet::modifyuser  This call is essentially a wrapper for lonnet::modifyuser and
   lonnet::modify_student_enrollment
   
 Inputs:   Inputs: 
   
Line 3692  Inputs: Line 3775  Inputs:
   
 =item *  =item *
   
   modify_student_enrollment
   
   Change a students enrollment status in a class.  The environment variable
   'role.request.course' must be defined for this function to proceed.
   
   Inputs:
   
   =over 4
   
   =item $udom, students domain
   
   =item $uname, students name
   
   =item $uid, students user id
   
   =item $first, students first name
   
   =item $middle
   
   =item $last
   
   =item $gene
   
   =item $usec
   
   =item $end
   
   =item $start
   
   =back
   
   
   =item *
   
 assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start) : assign  assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start) : assign
 custom role; give a custom role to a user for the level given by URL.  Specify  custom role; give a custom role to a user for the level given by URL.  Specify
 name and domain of role author, and role name  name and domain of role author, and role name
Removed from v.1.294  
changed lines
  Added in v.1.300

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