[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.457 and 1.464

version 1.457, 2003/12/08 13:50:57 version 1.464, 2004/01/26 21:58:34
Line 1319  sub flushcourselogs { Line 1319  sub flushcourselogs {
 # Writes to the dynamic metadata of resources to get hit counts, etc.  # Writes to the dynamic metadata of resources to get hit counts, etc.
 #  #
     foreach my $entry (keys(%accesshash)) {      foreach my $entry (keys(%accesshash)) {
         my ($dom,$name,undef,$type)=($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);          if ($entry =~ /___count$/) {
         if ($type eq 'count'){              my ($dom,$name);
               ($dom,$name,undef)=($entry=~m:___(\w+)/(\w+)/(.*)___count$:);
               if (! defined($dom) || $dom eq '' || 
                   ! defined($name) || $name eq '') {
                   my $cid = $ENV{'request.course.id'};
                   $dom  = $ENV{'request.'.$cid.'.domain'};
                   $name = $ENV{'request.'.$cid.'.num'};
               }
             my $value = $accesshash{$entry};              my $value = $accesshash{$entry};
             my (undef,$url,undef) = ($entry =~ /^(.*)___(.*)___count$/);              my (undef,$url,undef) = ($entry =~ /^(.*)___(.*)___count$/);
             my %temphash=($url => $value);              my %temphash=($url => $value);
Line 1335  sub flushcourselogs { Line 1342  sub flushcourselogs {
                 }                  }
             }              }
         } else {          } else {
               my ($dom,$name) = ($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
             my %temphash=($entry => $accesshash{$entry});              my %temphash=($entry => $accesshash{$entry});
             if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {              if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                 delete $accesshash{$entry};                  delete $accesshash{$entry};
Line 1375  sub courselog { Line 1383  sub courselog {
     } else {      } else {
  $courselogs{$ENV{'request.course.id'}}.=$what;   $courselogs{$ENV{'request.course.id'}}.=$what;
     }      }
 #    if (length($courselogs{$ENV{'request.course.id'}})>4048) {      if (length($courselogs{$ENV{'request.course.id'}})>4048) {
     if (length($courselogs{$ENV{'request.course.id'}})>48) {  
  &flushcourselogs();   &flushcourselogs();
     }      }
 }  }
Line 1398  sub courseacclog { Line 1405  sub courseacclog {
   
 sub countacc {  sub countacc {
     my $url=&declutter(shift);      my $url=&declutter(shift);
       return if (! defined($url) || $url eq '');
     unless ($ENV{'request.course.id'}) { return ''; }      unless ($ENV{'request.course.id'}) { return ''; }
     $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;      $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
     my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';      my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';
Line 2119  sub coursedescription { Line 2127  sub coursedescription {
     return %returnhash;      return %returnhash;
 }  }
   
   # -------------------------------------------------See if a user is privileged
   
   sub privileged {
       my ($username,$domain)=@_;
       my $rolesdump=&reply("dump:$domain:$username:roles",
    &homeserver($username,$domain));
       if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; }
       my $now=time;
       if ($rolesdump ne '') {
           foreach (split(/&/,$rolesdump)) {
       if ($_!~/^rolesdef\&/) {
    my ($area,$role)=split(/=/,$_);
    $area=~s/\_\w\w$//;
    my ($trole,$tend,$tstart)=split(/_/,$role);
    if (($trole eq 'dc') || ($trole eq 'su')) {
       my $active=1;
       if ($tend) {
    if ($tend<$now) { $active=0; }
       }
       if ($tstart) {
    if ($tstart>$now) { $active=0; }
       }
       if ($active) { return 1; }
    }
       }
    }
       }
       return 0;
   }
   
 # -------------------------------------------------------- Get user privileges  # -------------------------------------------------------- Get user privileges
   
 sub rolesinit {  sub rolesinit {
Line 3695  sub EXT { Line 3733  sub EXT {
     if ($$result{$courselevel}) {      if ($$result{$courselevel}) {
  return $$result{$courselevel}; }   return $$result{$courselevel}; }
  } else {   } else {
     if ($tmp!~/No such file/) {      #error 2 occurs when the .db doesn't exist
       if ($tmp!~/error: 2 /) {
  &logthis("<font color=blue>WARNING:".   &logthis("<font color=blue>WARNING:".
  " Trying to get resource data for ".   " Trying to get resource data for ".
  $uname." at ".$udom.": ".   $uname." at ".$udom.": ".
  $tmp."</font>");   $tmp."</font>");
     } elsif ($tmp=~/error:No such file/) {      } elsif ($tmp=~/error: 2 /) {
                         &EXT_cache_set($udom,$uname);                          &EXT_cache_set($udom,$uname);
     } elsif ($tmp =~ /^(con_lost|no_such_host)/) {      } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
  return $tmp;   return $tmp;
Line 3783  sub packages_tab_default { Line 3822  sub packages_tab_default {
     foreach my $package (split(/,/,$packages)) {      foreach my $package (split(/,/,$packages)) {
  my ($pack_type,$pack_part)=split(/_/,$package,2);   my ($pack_type,$pack_part)=split(/_/,$package,2);
  if ($pack_part eq $part) {   if ($pack_part eq $part) {
     return $packagetab{"$pack_type&$name&default"};      if (defined($packagetab{"$pack_type&$name&default"})) {
    return $packagetab{"$pack_type&$name&default"};
       }
  }   }
     }      }
     return undef;      return undef;
Line 4418  sub filelocation { Line 4459  sub filelocation {
     $location=$file;      $location=$file;
   } else {    } else {
     $file=~s/^$perlvar{'lonDocRoot'}//;      $file=~s/^$perlvar{'lonDocRoot'}//;
     $file=~s:^/*res::;      $file=~s:^/res/:/:;
     if ( !( $file =~ m:^/:) ) {      if ( !( $file =~ m:^/:) ) {
       $location = $dir. '/'.$file;        $location = $dir. '/'.$file;
     } else {      } else {
Line 4432  sub filelocation { Line 4473  sub filelocation {
   
 sub hreflocation {  sub hreflocation {
     my ($dir,$file)=@_;      my ($dir,$file)=@_;
     unless (($file=~/^http:\/\//i) || ($file=~/^\//)) {      unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
        my $finalpath=filelocation($dir,$file);   my $finalpath=filelocation($dir,$file);
        $finalpath=~s/^\/home\/httpd\/html//;   $finalpath=~s-^/home/httpd/html--;
        $finalpath=~s-/home/(\w+)/public_html/-/~$1/-;   $finalpath=~s-^/home/(\w+)/public_html/-/~$1/-;
        return $finalpath;   return $finalpath;
     } else {      } elsif ($file=~m-^/home-) {
        return $file;   $file=~s-^/home/httpd/html--;
    $file=~s-^/home/(\w+)/public_html/-/~$1/-;
    return $file;
     }      }
       return $file;
 }  }
   
 # ------------------------------------------------------------- Declutters URLs  # ------------------------------------------------------------- Declutters URLs
Removed from v.1.457  
changed lines
  Added in v.1.464

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