Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.398.2.1.2.1 and 1.399

version 1.398.2.1.2.1, 2003/08/22 16:24:45 version 1.399, 2003/08/12 19:46:04
Line 377  sub userload { Line 377  sub userload {
  my $curtime=time;   my $curtime=time;
  while ($filename=readdir(LONIDS)) {   while ($filename=readdir(LONIDS)) {
     if ($filename eq '.' || $filename eq '..') {next;}      if ($filename eq '.' || $filename eq '..') {next;}
     my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];      my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8];
     if ($curtime-$mtime < 3600) { $numusers++; }      if ($curtime-$atime < 3600) { $numusers++; }
  }   }
  closedir(LONIDS);   closedir(LONIDS);
     }      }
Line 1284  sub get_course_adv_roles { Line 1284  sub get_course_adv_roles {
     return %returnhash;      return %returnhash;
 }  }
   
   # ----------------------------------------------------- Frontpage Announcements
   #
   #
   
   sub postannounce {
       my ($server,$text)=@_;
       unless (&allowed('psa',$hostdom{$server})) { return 'refused'; }
       unless ($text=~/\w/) { $text=''; }
       return &reply('setannounce:'.&escape($text),$server);
   }
   
   sub getannounce {
       if (my $fh=Apache::File->new($perlvar{'lonDocRoot'}.'/announcement.txt')) {
    my $announcement='';
    while (<$fh>) { $announcement .=$_; }
    $fh->close();
    if ($announcement=~/\w/) { 
       return 
      '<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.
      '<tr><td bgcolor="#FFFFFF"><pre>'.$announcement.'</pre></td></tr></table>'; 
    } else {
       return '';
    }
       } else {
    return '';
       }
   }
   
 # ---------------------------------------------------------- Course ID routines  # ---------------------------------------------------------- Course ID routines
 # Deal with domain's nohist_courseid.db files  # Deal with domain's nohist_courseid.db files
 #  #
Line 3507  sub metadata { Line 3535  sub metadata {
         if ($liburi) {          if ($liburi) {
     $liburi=&declutter($liburi);      $liburi=&declutter($liburi);
             $filename=$liburi;              $filename=$liburi;
         } else {          }
     delete($metacache{$uri.':packages'});  
  }  
         my %metathesekeys=();          my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }          unless ($filename=~/\.meta$/) { $filename.='.meta'; }
  my $metastring=&getfile(&filelocation('',&clutter($filename)));   my $metastring=&getfile(&filelocation('',&clutter($filename)));
         my $parser=HTML::LCParser->new(\$metastring);          my $parser=HTML::LCParser->new(\$metastring);
         my $token;          my $token;
         undef %metathesekeys;          undef %metathesekeys;
    delete($metacache{$uri.':packages'});
         while ($token=$parser->get_token) {          while ($token=$parser->get_token) {
     if ($token->[0] eq 'S') {      if ($token->[0] eq 'S') {
  if (defined($token->[2]->{'package'})) {   if (defined($token->[2]->{'package'})) {

Removed from v.1.398.2.1.2.1  
changed lines
  Added in v.1.399


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