[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.507 and 1.513

version 1.507, 2004/06/09 14:57:30 version 1.513, 2004/06/21 22:01:39
Line 1615  sub courseidput { Line 1615  sub courseidput {
 }  }
   
 sub courseiddump {  sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$hostid)=@_;      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 (($hostid && $tryserver eq $hostid) || (!$hostid)) {          if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {
     if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {      if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
         foreach (          foreach (
                  split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.                   split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
Line 3054  sub log_query { Line 3054  sub log_query {
     return get_query_reply($queryid);      return get_query_reply($queryid);
 }  }
   
 # ------- Request retrieval of institutional classlists from course homerserver  # ------- Request retrieval of institutional classlists for course(s)
   
 sub fetch_enrollment_query {  sub fetch_enrollment_query {
     my ($homeserver,$dom,$affiliatesref,$replyref) = @_;      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 $host=$hostname{$homeserver};
     my $cmd = '';      my $cmd = '';
     foreach (keys %{$affiliatesref}) {      foreach (keys %{$affiliatesref}) {
         $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';           $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';
     }      }
     $cmd =~ s/%%$//;      $cmd =~ s/%%$//;
     $cmd = &escape($cmd);      $cmd = &escape($cmd);
Line 3143  sub userlog_query { Line 3149  sub userlog_query {
 #--------- Call auto-enrollment subs in localenroll.pm for homeserver for course   #--------- Call auto-enrollment subs in localenroll.pm for homeserver for course 
   
 sub auto_run {  sub auto_run {
     my $homeserver = shift;      my ($cnum,$cdom) = @_;
     my $response = &reply('autorun',$homeserver);      my $homeserver = &homeserver($cnum,$cdom);
       my $response = &reply('autorun:'.$cdom,$homeserver);
     return $response;      return $response;
 }  }
                                                                                                                                                                         
 sub auto_get_sections {  sub auto_get_sections {
     my ($homeserver,$coursecode) = @_;      my ($cnum,$cdom,$inst_coursecode) = @_;
       my $homeserver = &homeserver($cnum,$cdom);
     my @secs = ();      my @secs = ();
     my $response=&unescape(&reply('autogetsections:'.$coursecode,$homeserver));      my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
     unless ($response eq 'refused') {      unless ($response eq 'refused') {
         @secs = split/:/,$response;          @secs = split/:/,$response;
     }      }
Line 3159  sub auto_get_sections { Line 3167  sub auto_get_sections {
 }  }
                                                                                                                                                                         
 sub auto_new_course {  sub auto_new_course {
     my ($homeserver,$course_id,$owner) = @_;      my ($cnum,$cdom,$inst_course_id,$owner) = @_;
     my $response=&unescape(&reply('autonewcourse:'.$course_id.':'.$owner,$homeserver));      my $homeserver = &homeserver($cnum,$cdom);
       my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner,':'.$cdom,$homeserver));
     return $response;      return $response;
 }  }
                                                                                                                                                                         
 sub auto_validate_courseID {  sub auto_validate_courseID {
     my ($homeserver,$course_id) = @_;      my ($cnum,$cdom,$inst_course_id) = @_;
     my $response=&unescape(&reply('autovalidatecourse:'.$course_id,$homeserver));      my $homeserver = &homeserver($cnum,$cdom);
       my $response=&unescape(&reply('autovalidatecourse:'.$inst_course_id.':'.$cdom,$homeserver));
     return $response;      return $response;
 }  }
                                                                                                                                                                         
 sub auto_create_password {  sub auto_create_password {
     my ($homeserver,$authparam) = @_;      my ($cnum,$cdom,$authparam) = @_;
       my $homeserver = &homeserver($cnum,$cdom); 
     my $create_passwd = 0;      my $create_passwd = 0;
     my $authchk = '';      my $authchk = '';
     my $response=&unescape(&reply('autocreatepassword:'.$authparam,$homeserver));      my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
     if ($response eq 'refused') {      if ($response eq 'refused') {
         $authchk = 'refused';          $authchk = 'refused';
     } else {      } else {
Line 3564  sub revokecustomrole { Line 3575  sub revokecustomrole {
            $deleteflag);             $deleteflag);
 }  }
   
   
   # ------------------------------------------------------------ Portfolio Director Lister
   sub portfoliolist {
    # returns listing of contents of user's /userfiles/portfolio/ directory
    # 
    my ($udom, $uname, $uhome);
    $uname=$ENV{'user.name'};
           $udom=$ENV{'user.domain'};
           $uhome=$ENV{'user.home'};
    my $listing = reply('portls:'.$uname.':'.$udom, $uhome);
    return $listing;
   }
   sub portfoliomanage {
    # handles deleting and renaming files in user's userfiles/portfolio/ directory
    # 
    my ($filename, $fileaction, $filenewname) = @_;
    my ($udom, $uname, $uhome);
    $uname=$ENV{'user.name'};
           $udom=$ENV{'user.domain'};
           $uhome=$ENV{'user.home'};
    my $listing = reply('portfoliomanage:'.$uname.':'.$udom.':'.$filename.':'.$fileaction.':'.$filenewname, $uhome);
    return $listing;
   }
   
   
 # ------------------------------------------------------------ Directory lister  # ------------------------------------------------------------ Directory lister
   
 sub dirlist {  sub dirlist {
Line 4359  sub symblist { Line 4395  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 4369  sub symbverify { Line 4408  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 4376  sub symbverify { Line 4416  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 4409  sub symbclean { Line 4449  sub symbclean {
   
 # remove wrapper  # remove wrapper
   
     $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\//$1/;      $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/;
     return $symb;      return $symb;
 }  }
   
Line 4965  sub declutter { Line 5005  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.507  
changed lines
  Added in v.1.513

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