[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.918 and 1.922

version 1.918, 2007/10/03 19:57:26 version 1.922, 2007/11/06 13:05:00
Line 1383  sub do_cache_new { Line 1383  sub do_cache_new {
  $memcache->disconnect_all();   $memcache->disconnect_all();
     }      }
     # need to make a copy of $value      # need to make a copy of $value
     #&make_room($id,$value,$debug);      &make_room($id,$value,$debug);
     return $value;      return $value;
 }  }
   
 sub make_room {  sub make_room {
     my ($id,$value,$debug)=@_;      my ($id,$value,$debug)=@_;
     $remembered{$id}=$value;  
       $remembered{$id}= (ref($value)) ? &Storable::dclone($value)
                                       : $value;
     if ($to_remember<0) { return; }      if ($to_remember<0) { return; }
     $accessed{$id}=[&gettimeofday()];      $accessed{$id}=[&gettimeofday()];
     if (scalar(keys(%remembered)) <= $to_remember) { return; }      if (scalar(keys(%remembered)) <= $to_remember) { return; }
Line 2170  sub flushcourselogs { Line 2172  sub flushcourselogs {
 # times and course titles for all courseids  # times and course titles for all courseids
 #  #
     my %courseidbuffer=();      my %courseidbuffer=();
     foreach my $crsid (keys %courselogs) {      foreach my $crsid (keys(%courselogs)) {
         if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'.          if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'.
           &escape($courselogs{$crsid}),            &escape($courselogs{$crsid}),
           $coursehombuf{$crsid}) eq 'ok') {            $coursehombuf{$crsid}) eq 'ok') {
Line 2183  sub flushcourselogs { Line 2185  sub flushcourselogs {
                delete $courselogs{$crsid};                 delete $courselogs{$crsid};
             }              }
         }          }
         $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = (          $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = {
             'description' => &escape($coursedescrbuf{$crsid}),              'description' => &escape($coursedescrbuf{$crsid}),
             'instcode'    => &escape($courseinstcodebuf{$crsid}),              'inst_code'    => &escape($courseinstcodebuf{$crsid}),
             'type'        => &escape($coursetypebuf{$crsid}),              'type'        => &escape($coursetypebuf{$crsid}),
             'owner'       => &escape($courseownerbuf{$crsid}),              'owner'       => &escape($courseownerbuf{$crsid}),
         );          };
     }      }
 #  #
 # Write course id database (reverse lookup) to homeserver of courses   # Write course id database (reverse lookup) to homeserver of courses 
Line 2196  sub flushcourselogs { Line 2198  sub flushcourselogs {
 #  #
     foreach my $crs_home (keys(%courseidbuffer)) {      foreach my $crs_home (keys(%courseidbuffer)) {
         my $response = &courseidput(&host_domain($crs_home),          my $response = &courseidput(&host_domain($crs_home),
                                     $courseidbuffer{$crs_home},$crs_home);                                      $courseidbuffer{$crs_home},
                                       $crs_home,'timeonly');
     }      }
 #  #
 # File accesses  # File accesses
Line 2460  sub get_my_roles { Line 2463  sub get_my_roles {
         }          }
         if (ref($roles) eq 'ARRAY') {          if (ref($roles) eq 'ARRAY') {
             if (!grep(/^\Q$role\E$/,@{$roles})) {              if (!grep(/^\Q$role\E$/,@{$roles})) {
                 next;                  if ($role =~ /^cr\//) {
                       if (!grep(/^cr$/,@{$roles})) {
                           next;
                       }
                   } else {
                       next;
                   }
             }              }
         }          }
  $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;   $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
Line 2502  sub getannounce { Line 2511  sub getannounce {
 #  #
   
 sub courseidput {  sub courseidput {
     my ($domain,$storehash,$coursehome)=@_;      my ($domain,$storehash,$coursehome,$caller) = @_;
     my $items='';      my $outcome;
     my $now = time;      if ($caller eq 'timeonly') {
     foreach my $item (keys(%$storehash)) {          my $cids = '';
         $storehash->{$item}{'lasttime'} = $now;          foreach my $item (keys(%$storehash)) {
         $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';              $cids.=&escape($item).'&';
           }
           $cids=~s/\&$//;
           $outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$cids,
                             $coursehome);       
       } else {
           my $items = '';
           foreach my $item (keys(%$storehash)) {
               $items.= &escape($item).'='.
                        &freeze_escape($$storehash{$item}).'&';
           }
           $items=~s/\&$//;
           $outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$items,
                             $coursehome);
     }      }
     $items=~s/\&$//;  
     my $outcome = &reply('courseidputhash:'.$domain.':'.$items,$coursehome);  
     if ($outcome eq 'unknown_cmd') {      if ($outcome eq 'unknown_cmd') {
         my $what;          my $what;
         foreach my $cid (keys(%$storehash)) {          foreach my $cid (keys(%$storehash)) {
             $what .= &escape($cid).'=';              $what .= &escape($cid).'=';
             foreach my $item ('description','instcode','owner','type') {              foreach my $item ('description','inst_code','owner','type') {
                 $what .= $storehash->{$item}.':';                  $what .= &escape($storehash->{$item}).':';
             }              }
             $what =~ s/\:$/&/;              $what =~ s/\:$/&/;
         }          }
Line 2528  sub courseidput { Line 2548  sub courseidput {
 }  }
   
 sub courseiddump {  sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;      my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
           $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
     my $as_hash = 1;      my $as_hash = 1;
     my %returnhash;      my %returnhash;
     if (!$domfilter) { $domfilter=''; }      if (!$domfilter) { $domfilter=''; }
Line 2545  sub courseiddump { Line 2566  sub courseiddump {
                          $sincefilter.':'.&escape($descfilter).':'.                           $sincefilter.':'.&escape($descfilter).':'.
                          &escape($instcodefilter).':'.&escape($ownerfilter).                           &escape($instcodefilter).':'.&escape($ownerfilter).
                          ':'.&escape($coursefilter).':'.&escape($typefilter).                           ':'.&escape($coursefilter).':'.&escape($typefilter).
                          ':'.&escape($regexp_ok).':'.$as_hash,$tryserver);                            ':'.&escape($regexp_ok).':'.$as_hash,$tryserver);
                 my @pairs=split(/\&/,$rep);                  my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {                  foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);                      my ($key,$value)=split(/\=/,$item,2);
Line 2555  sub courseiddump { Line 2576  sub courseiddump {
                     if (ref($result) eq 'HASH') {                      if (ref($result) eq 'HASH') {
                         $returnhash{$key}=$result;                          $returnhash{$key}=$result;
                     } else {                      } else {
                         my @responses = split(/:/,$result);                          my @responses = split(/:/,$value);
                         my @items = ('description','instcode','owner','type');                          my @items = ('description','inst_code','owner','type');
                         for (my $i=0; $i<@responses; $i++) {                          for (my $i=0; $i<@responses; $i++) {
                             $returnhash{$key}{$items[$i]} = $responses[$i];                              $returnhash{$key}{$items[$i]} = &unescape($responses[$i]);
                         }                          }
                     }                       } 
                 }                  }
Line 2606  sub get_domain_roles { Line 2627  sub get_domain_roles {
     if (undef($enddate) || $enddate eq '') {      if (undef($enddate) || $enddate eq '') {
         $enddate = '.';          $enddate = '.';
     }      }
     my $rolelist = join(':',@{$roles});      my $rolelist;
       if (ref($roles) eq 'ARRAY') {
           $rolelist = join(':',@{$roles});
       }
     my %personnel = ();      my %personnel = ();
   
     my %servers = &get_servers($dom,'library');      my %servers = &get_servers($dom,'library');
Line 5546  sub createcourse { Line 5570  sub createcourse {
 # log existence  # log existence
     my $newcourse = {      my $newcourse = {
                     $udom.'_'.$uname => {                      $udom.'_'.$uname => {
                                      description => &escape($description),                                       description => $description,
                                      inst_code   => &escape($inst_code),                                       inst_code   => $inst_code,
                                      owner       => &escape($course_owner),                                       owner       => $course_owner,
                                      type        => &escape($crstype),                                       type        => $crstype,
                                                 },                                                  },
                     };                      };
     &courseidput($udom,$newcourse);      &courseidput($udom,$newcourse,$uhome,'notime');
     &flushcourselogs();  
 # set toplevel url  # set toplevel url
     my $topurl=$url;      my $topurl=$url;
     unless ($nonstandard) {      unless ($nonstandard) {
Removed from v.1.918  
changed lines
  Added in v.1.922

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