[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.504 and 1.511

version 1.504, 2004/05/27 22:25:16 version 1.511, 2004/06/17 18:31:25
Line 1615  sub courseidput { Line 1615  sub courseidput {
 }  }
   
 sub courseiddump {  sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter)=@_;      my ($domfilter,$descfilter,$sincefilter,$hostidflag,$hostidref)=@_;
     my %returnhash=();      my %returnhash=();
     unless ($domfilter) { $domfilter=''; }      unless ($domfilter) { $domfilter=''; }
     foreach my $tryserver (keys %libserv) {      foreach my $tryserver (keys %libserv) {
  if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {          if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {
     foreach (      if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
              split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.          foreach (
                    split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
        $sincefilter.':'.&escape($descfilter),         $sincefilter.':'.&escape($descfilter),
                                $tryserver))) {                                 $tryserver))) {
  my ($key,$value)=split(/\=/,$_);      my ($key,$value)=split(/\=/,$_);
                 if (($key) && ($value)) {                      if (($key) && ($value)) {
     $returnhash{&unescape($key)}=&unescape($value);          $returnhash{&unescape($key)}=&unescape($value);
                       }
                 }                  }
             }              }
   
         }          }
     }      }
     return %returnhash;      return %returnhash;
Line 1653  sub set_first_access { Line 1654  sub set_first_access {
     my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();      my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
     my ($map,$id,$res)=&decode_symb($symb);      my ($map,$id,$res)=&decode_symb($symb);
     if ($type eq 'map') { $res=$map; }      if ($type eq 'map') { $res=$map; }
     return &put('firstaccesstimes',{$res=>time},$udom,$uname);      my $firstaccess=&get_first_access($type);
       if (!$firstaccess) {
    return &put('firstaccesstimes',{$res=>time},$udom,$uname);
       }
       return 'already_set';
 }  }
   
 sub checkout {  sub checkout {
Line 3049  sub log_query { Line 3054  sub log_query {
     return get_query_reply($queryid);      return get_query_reply($queryid);
 }  }
   
   # ------- Request retrieval of institutional classlists for course(s)
   
   sub fetch_enrollment_query {
       my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_;
       my $homeserver;
       if ($context eq 'automated') {
           $homeserver = $perlvar{'lonHostID'};
       } else {
           $homeserver = &homeserver($cnum,$dom);
       }
       my $host=$hostname{$homeserver};
       my $cmd = '';
       foreach (keys %{$affiliatesref}) {
           $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';
       }
       $cmd =~ s/%%$//;
       $cmd = &escape($cmd);
       my $query = 'fetchenrollment';
       my $queryid=&reply("querysend:".$query.':'.$dom.':'.$ENV{'user.name'}.':'.$cmd,$homeserver);
       unless ($queryid=~/^\Q$host\E\_/) { return 'error: '.$queryid; }
       my $reply = &get_query_reply($queryid);
       unless ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
           unless ($homeserver eq $perlvar{'lonHostID'}) {
               my @responses = split/:/,$reply;
               my $pathname = $perlvar{'lonDaemons'}.'/tmp';
               foreach (@responses) {
                   my ($key,$value) = split/=/,$_;
                   $$replyref{$key} = $value;
                   if ($value > 0) {
                       foreach (@{$$affiliatesref{$key}}) {
                           my $filename = $dom.'_'.$key.'_'.$_.'_classlist.xml';
                           my $destname = $pathname.'/'.$filename;
                           my $xml_classlist = &reply("autoretrieve:".$filename,$homeserver);
                           unless ($xml_classlist =~ /^error/) {
                               if ( open(FILE,">$destname") ) {
                                   print FILE &unescape($xml_classlist);
                                   close(FILE);
                               }
                           }
                       }
                   }
               }
           }
           return 'ok';
       }
       return 'error';
   }
   
 sub get_query_reply {  sub get_query_reply {
     my $queryid=shift;      my $queryid=shift;
     my $replyfile=$perlvar{'lonDaemons'}.'/tmp/'.$queryid;      my $replyfile=$perlvar{'lonDaemons'}.'/tmp/'.$queryid;
Line 3093  sub userlog_query { Line 3146  sub userlog_query {
     return &log_query($uname,$udom,'userlog',%filters);      return &log_query($uname,$udom,'userlog',%filters);
 }  }
   
   #--------- Call auto-enrollment subs in localenroll.pm for homeserver for course 
   
   sub auto_run {
       my ($cnum,$cdom) = @_;
       my $homeserver = &homeserver($cnum,$cdom);
       my $response = &reply('autorun:'.$cdom,$homeserver);
       return $response;
   }
                                                                                      
   sub auto_get_sections {
       my ($cnum,$cdom,$inst_coursecode) = @_;
       my $homeserver = &homeserver($cnum,$cdom);
       my @secs = ();
       my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
       unless ($response eq 'refused') {
           @secs = split/:/,$response;
       }
       return @secs;
   }
                                                                                      
   sub auto_new_course {
       my ($cnum,$cdom,$inst_course_id,$owner) = @_;
       my $homeserver = &homeserver($cnum,$cdom);
       my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner,':'.$cdom,$homeserver));
       return $response;
   }
                                                                                      
   sub auto_validate_courseID {
       my ($cnum,$cdom,$inst_course_id) = @_;
       my $homeserver = &homeserver($cnum,$cdom);
       my $response=&unescape(&reply('autovalidatecourse:'.$inst_course_id.':'.$cdom,$homeserver));
       return $response;
   }
                                                                                      
   sub auto_create_password {
       my ($cnum,$cdom,$authparam) = @_;
       my $homeserver = &homeserver($cnum,$cdom); 
       my $create_passwd = 0;
       my $authchk = '';
       my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
       if ($response eq 'refused') {
           $authchk = 'refused';
       } else {
           ($authparam,$create_passwd,$authchk) = split/:/,$response;
       }
       return ($authparam,$create_passwd,$authchk);
   }
   
 # ------------------------------------------------------------------ Plain Text  # ------------------------------------------------------------------ Plain Text
   
 sub plaintext {  sub plaintext {
Line 4269  sub symblist { Line 4370  sub symblist {
 # --------------------------------------------------------------- Verify a symb  # --------------------------------------------------------------- Verify a symb
   
 sub symbverify {  sub symbverify {
     my ($symb,$thisfn)=@_;      my ($symb,$thisurl)=@_;
       my $thisfn=$thisurl;
   # wrapper not part of symbs
       $thisfn=~s/^\/adm\/wrapper//;
     $thisfn=&declutter($thisfn);      $thisfn=&declutter($thisfn);
 # direct jump to resource in page or to a sequence - will construct own symbs  # direct jump to resource in page or to a sequence - will construct own symbs
     if ($thisfn=~/\.(page|sequence)$/) { return 1; }      if ($thisfn=~/\.(page|sequence)$/) { return 1; }
Line 4279  sub symbverify { Line 4383  sub symbverify {
     unless ($url eq $thisfn) { return 0; }      unless ($url eq $thisfn) { return 0; }
   
     $symb=&symbclean($symb);      $symb=&symbclean($symb);
       $thisurl=&deversion($thisurl);
     $thisfn=&deversion($thisfn);      $thisfn=&deversion($thisfn);
   
     my %bighash;      my %bighash;
Line 4286  sub symbverify { Line 4391  sub symbverify {
   
     if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',      if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
                             &GDBM_READER(),0640)) {                              &GDBM_READER(),0640)) {
         my $ids=$bighash{'ids_'.&clutter($thisfn)};          my $ids=$bighash{'ids_'.&clutter($thisurl)};
         unless ($ids) {           unless ($ids) { 
            $ids=$bighash{'ids_/'.$thisfn};             $ids=$bighash{'ids_/'.$thisurl};
         }          }
         if ($ids) {          if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)  # ------------------------------------------------------------------- Has ID(s)
Line 4317  sub symbclean { Line 4422  sub symbclean {
 # remove version from URL  # remove version from URL
     $symb=~s/\.(\d+)\.(\w+)$/\.$2/;      $symb=~s/\.(\d+)\.(\w+)$/\.$2/;
   
   # remove wrapper
   
       $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/;
     return $symb;      return $symb;
 }  }
   
Line 4872  sub declutter { Line 4980  sub declutter {
   
 sub clutter {  sub clutter {
     my $thisfn='/'.&declutter(shift);      my $thisfn='/'.&declutter(shift);
     unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv)\//) {       unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv|public)\//) { 
        $thisfn='/res'.$thisfn;          $thisfn='/res'.$thisfn; 
     }      }
     return $thisfn;      return $thisfn;
Removed from v.1.504  
changed lines
  Added in v.1.511

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