[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.921 and 1.939

version 1.921, 2007/10/06 04:32:40 version 1.939, 2008/01/21 20:21:28
Line 513  sub get_env_multiple { Line 513  sub get_env_multiple {
 }  }
   
 # ------------------------------------------ Find out current server userload  # ------------------------------------------ Find out current server userload
 # there is a copy in lond  
 sub userload {  sub userload {
     my $numusers=0;      my $numusers=0;
     {      {
Line 521  sub userload { Line 520  sub userload {
  my $filename;   my $filename;
  my $curtime=time;   my $curtime=time;
  while ($filename=readdir(LONIDS)) {   while ($filename=readdir(LONIDS)) {
     if ($filename eq '.' || $filename eq '..') {next;}      next if ($filename eq '.' || $filename eq '..');
       next if ($filename =~ /publicuser_\d+\.id/);
     my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];      my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
     if ($curtime-$mtime < 1800) { $numusers++; }      if ($curtime-$mtime < 1800) { $numusers++; }
  }   }
Line 1047  sub get_instuser { Line 1047  sub get_instuser {
 }  }
   
 sub inst_rulecheck {  sub inst_rulecheck {
     my ($udom,$uname,$rules) = @_;      my ($udom,$uname,$id,$item,$rules) = @_;
     my %returnhash;      my %returnhash;
     if ($udom ne '') {      if ($udom ne '') {
         if (ref($rules) eq 'ARRAY') {          if (ref($rules) eq 'ARRAY') {
Line 1055  sub inst_rulecheck { Line 1055  sub inst_rulecheck {
             my $rulestr = join(':',@{$rules});              my $rulestr = join(':',@{$rules});
             my $homeserver=&domain($udom,'primary');              my $homeserver=&domain($udom,'primary');
             if (($homeserver ne '') && ($homeserver ne 'no_host')) {              if (($homeserver ne '') && ($homeserver ne 'no_host')) {
                 my $response=&unescape(&reply('instrulecheck:'.&escape($udom).':'.                  my $response;
                                               &escape($uname).':'.$rulestr,                  if ($item eq 'username') {                
                       $response=&unescape(&reply('instrulecheck:'.&escape($udom).
                                                 ':'.&escape($uname).':'.$rulestr,
                                               $homeserver));                                                $homeserver));
                   } elsif ($item eq 'id') {
                       $response=&unescape(&reply('instidrulecheck:'.&escape($udom).
                                                 ':'.&escape($id).':'.$rulestr,
                                                 $homeserver));
                   }
                 if ($response ne 'refused') {                  if ($response ne 'refused') {
                     my @pairs=split(/\&/,$response);                      my @pairs=split(/\&/,$response);
                     foreach my $item (@pairs) {                      foreach my $item (@pairs) {
Line 1074  sub inst_rulecheck { Line 1081  sub inst_rulecheck {
 }  }
   
 sub inst_userrules {  sub inst_userrules {
     my ($udom) = @_;      my ($udom,$check) = @_;
     my (%ruleshash,@ruleorder);      my (%ruleshash,@ruleorder);
     if ($udom ne '') {      if ($udom ne '') {
         my $homeserver=&domain($udom,'primary');          my $homeserver=&domain($udom,'primary');
         if (($homeserver ne '') && ($homeserver ne 'no_host')) {          if (($homeserver ne '') && ($homeserver ne 'no_host')) {
             my $response=&reply('instuserrules:'.&escape($udom),              my $response;
               if ($check eq 'id') {
                   $response=&reply('instidrules:'.&escape($udom),
                                  $homeserver);                                   $homeserver);
               } else {
                   $response=&reply('instuserrules:'.&escape($udom),
                                    $homeserver);
               }
             if (($response ne 'refused') && ($response ne 'error') &&               if (($response ne 'refused') && ($response ne 'error') && 
                   ($response ne 'unknown_cmd') && 
                 ($response ne 'no_such_host')) {                  ($response ne 'no_such_host')) {
                 my ($hashitems,$orderitems) = split(/:/,$response);                  my ($hashitems,$orderitems) = split(/:/,$response);
                 my @pairs=split(/\&/,$hashitems);                  my @pairs=split(/\&/,$hashitems);
Line 1621  sub ssi_body { Line 1635  sub ssi_body {
                                      &ssi($filelink,%form));                                       &ssi($filelink,%form));
     $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;      $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;
     $output=~s/^.*?\<body[^\>]*\>//si;      $output=~s/^.*?\<body[^\>]*\>//si;
     $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;      $output=~s/\<\/body\s*\>.*?$//si;
     return $output;      return $output;
 }  }
   
Line 2186  sub flushcourselogs { Line 2200  sub flushcourselogs {
             }              }
         }          }
         $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = {          $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = {
             'description' => &escape($coursedescrbuf{$crsid}),              'description' => $coursedescrbuf{$crsid},
             'inst_code'    => &escape($courseinstcodebuf{$crsid}),              'inst_code'    => $courseinstcodebuf{$crsid},
             'type'        => &escape($coursetypebuf{$crsid}),              'type'        => $coursetypebuf{$crsid},
             'owner'       => &escape($courseownerbuf{$crsid}),              'owner'       => $courseownerbuf{$crsid},
         };          };
     }      }
 #  #
Line 2385  sub get_course_adv_roles { Line 2399  sub get_course_adv_roles {
     my %coursehash=&coursedescription($cid);      my %coursehash=&coursedescription($cid);
     my %nothide=();      my %nothide=();
     foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {      foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
  $nothide{join(':',split(/[\@\:]/,$user))}=1;          if ($user !~ /:/) {
       $nothide{join(':',split(/[\@]/,$user))}=1;
           } else {
               $nothide{$user}=1;
           }
     }      }
     my %returnhash=();      my %returnhash=();
     my %dumphash=      my %dumphash=
Line 2413  sub get_course_adv_roles { Line 2431  sub get_course_adv_roles {
 }  }
   
 sub get_my_roles {  sub get_my_roles {
     my ($uname,$udom,$context,$types,$roles,$roledoms)=@_;      my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec,$hidepriv)=@_;
     unless (defined($uname)) { $uname=$env{'user.name'}; }      unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }      unless (defined($udom)) { $udom=$env{'user.domain'}; }
     my %dumphash;      my (%dumphash,%nothide);
     if ($context eq 'userroles') {       if ($context eq 'userroles') { 
         %dumphash = &dump('roles',$udom,$uname);          %dumphash = &dump('roles',$udom,$uname);
     } else {      } else {
         %dumphash=          %dumphash=
             &dump('nohist_userroles',$udom,$uname);              &dump('nohist_userroles',$udom,$uname);
           if ($hidepriv) {
               my %coursehash=&coursedescription($udom.'_'.$uname);
               foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   if ($user !~ /:/) {
                       $nothide{join(':',split(/[\@]/,$user))} = 1;
                   } else {
                       $nothide{$user} = 1;
                   }
               }
           }
     }      }
     my %returnhash=();      my %returnhash=();
     my $now=time;      my $now=time;
Line 2434  sub get_my_roles { Line 2462  sub get_my_roles {
         }          }
         if (($tstart) && ($tstart<0)) { next; }          if (($tstart) && ($tstart<0)) { next; }
         my $status = 'active';          my $status = 'active';
         if (($tend) && ($tend<$now)) {          if (($tend) && ($tend<=$now)) {
             $status = 'previous';              $status = 'previous';
         }           } 
         if (($tstart) && ($now<$tstart)) {          if (($tstart) && ($now<$tstart)) {
Line 2463  sub get_my_roles { Line 2491  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})) {
                   if ($role =~ /^cr\//) {
                       if (!grep(/^cr$/,@{$roles})) {
                           next;
                       }
                   } else {
                       next;
                   }
               }
           }
           if ($hidepriv) {
               if ((&privileged($username,$domain)) &&
                   (!$nothide{$username.':'.$domain})) { 
                 next;                  next;
             }              }
         }          }
  $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;          if ($withsec) {
               $returnhash{$username.':'.$domain.':'.$role.':'.$section} =
                   $tstart.':'.$tend;
           } else {
               $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
           }
     }      }
     return %returnhash;      return %returnhash;
 }  }
Line 2530  sub courseidput { Line 2575  sub courseidput {
         foreach my $cid (keys(%$storehash)) {          foreach my $cid (keys(%$storehash)) {
             $what .= &escape($cid).'=';              $what .= &escape($cid).'=';
             foreach my $item ('description','inst_code','owner','type') {              foreach my $item ('description','inst_code','owner','type') {
                 $what .= &escape($storehash->{$item}).':';                  $what .= &escape($storehash->{$cid}{$item}).':';
             }              }
             $what =~ s/\:$/&/;              $what =~ s/\:$/&/;
         }          }
Line 2621  sub get_domain_roles { Line 2666  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 2647  sub get_first_access { Line 2695  sub get_first_access {
     my ($symb,$courseid,$udom,$uname)=&whichuser();      my ($symb,$courseid,$udom,$uname)=&whichuser();
     if ($argsymb) { $symb=$argsymb; }      if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);      my ($map,$id,$res)=&decode_symb($symb);
     if ($type eq 'map') {      if ($type eq 'course') {
    $res='course';
       } elsif ($type eq 'map') {
  $res=&symbread($map);   $res=&symbread($map);
     } else {      } else {
  $res=$symb;   $res=$symb;
Line 2660  sub set_first_access { Line 2710  sub set_first_access {
     my ($type)=@_;      my ($type)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();      my ($symb,$courseid,$udom,$uname)=&whichuser();
     my ($map,$id,$res)=&decode_symb($symb);      my ($map,$id,$res)=&decode_symb($symb);
     if ($type eq 'map') {      if ($type eq 'course') {
    $res='course';
       } elsif ($type eq 'map') {
  $res=&symbread($map);   $res=&symbread($map);
     } else {      } else {
  $res=$symb;   $res=$symb;
Line 4816  sub auto_run { Line 4868  sub auto_run {
             $response = 1;              $response = 1;
         }          }
     } else {      } else {
         my $homeserver = &homeserver($cnum,$cdom);          my $homeserver;
         $response = &reply('autorun:'.$cdom,$homeserver);          if (&is_course($cdom,$cnum)) {
               $homeserver = &homeserver($cnum,$cdom);
           } else {
               $homeserver = &domain($cdom,'primary');
           }
           if ($homeserver ne 'no_host') {
               $response = &reply('autorun:'.$cdom,$homeserver);
           }
     }      }
     return $response;      return $response;
 }  }
Line 5223  sub assignrole { Line 5282  sub assignrole {
     } else {      } else {
         my $cwosec=$url;          my $cwosec=$url;
         $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;          $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
         unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) {           if (!(&allowed('c'.$role,$cwosec)) && !(&allowed('c'.$role,$udom))) {
            &logthis('Refused assignrole: '.              my $refused;
              $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.              if (($env{'request.course.sec'}  ne '') && ($role eq 'st')) {
     $env{'user.name'}.' at '.$env{'user.domain'});                  if (!(&allowed('c'.$role,$url))) {
            return 'refused';                       $refused = 1;
                   }
               } else {
                   $refused = 1;
               }
               if ($refused) { 
                   &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
                            ' '.$role.' '.$end.' '.$start.' by '.
              $env{'user.name'}.' at '.$env{'user.domain'});
                   return 'refused';
               }
         }          }
         $mrole=$role;          $mrole=$role;
     }      }
Line 6369  sub resdata { Line 6438  sub resdata {
     }      }
     if (!ref($result)) { return $result; }          if (!ref($result)) { return $result; }    
     foreach my $item (@which) {      foreach my $item (@which) {
  if (defined($result->{$item})) {   if (defined($result->{$item->[0]})) {
     return $result->{$item};      return [$result->{$item->[0]},$item->[1]];
  }   }
     }      }
     return undef;      return undef;
Line 6582  sub EXT { Line 6651  sub EXT {
 # ----------------------------------------------------------- first, check user  # ----------------------------------------------------------- first, check user
   
     my $userreply=&resdata($uname,$udom,'user',      my $userreply=&resdata($uname,$udom,'user',
        ($courselevelr,$courselevelm,         ([$courselevelr,'resource'],
  $courselevel));   [$courselevelm,'map'     ],
     if (defined($userreply)) { return $userreply; }   [$courselevel, 'course'  ]));
       if (defined($userreply)) { return &get_reply($userreply); }
   
 # ------------------------------------------------ second, check some of course  # ------------------------------------------------ second, check some of course
             my $coursereply;              my $coursereply;
             if (@groups > 0) {              if (@groups > 0) {
                 $coursereply = &check_group_parms($courseid,\@groups,$symbparm,                  $coursereply = &check_group_parms($courseid,\@groups,$symbparm,
                                        $mapparm,$spacequalifierrest);                                         $mapparm,$spacequalifierrest);
                 if (defined($coursereply)) { return $coursereply; }                  if (defined($coursereply)) { return &get_reply($coursereply); }
             }              }
   
     $coursereply=&resdata($env{'course.'.$courseid.'.num'},      $coursereply=&resdata($env{'course.'.$courseid.'.num'},
      $env{'course.'.$courseid.'.domain'},    $env{'course.'.$courseid.'.domain'},
      'course',    'course',
      ($seclevelr,$seclevelm,$seclevel,    ([$seclevelr,   'resource'],
       $courselevelr));     [$seclevelm,   'map'     ],
     if (defined($coursereply)) { return $coursereply; }     [$seclevel,    'course'  ],
      [$courselevelr,'resource']));
       if (defined($coursereply)) { return &get_reply($coursereply); }
   
 # ------------------------------------------------------ third, check map parms  # ------------------------------------------------------ third, check map parms
     my %parmhash=();      my %parmhash=();
Line 6610  sub EXT { Line 6682  sub EXT {
  $thisparm=$parmhash{$symbparm};   $thisparm=$parmhash{$symbparm};
  untie(%parmhash);   untie(%parmhash);
     }      }
     if ($thisparm) { return $thisparm; }      if ($thisparm) { return &get_reply([$thisparm,'resource']); }
  }   }
 # ------------------------------------------ fourth, look in resource metadata  # ------------------------------------------ fourth, look in resource metadata
   
Line 6623  sub EXT { Line 6695  sub EXT {
     $filename=$env{'request.filename'};      $filename=$env{'request.filename'};
  }   }
  my $metadata=&metadata($filename,$spacequalifierrest);   my $metadata=&metadata($filename,$spacequalifierrest);
  if (defined($metadata)) { return $metadata; }   if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
  $metadata=&metadata($filename,'parameter_'.$spacequalifierrest);   $metadata=&metadata($filename,'parameter_'.$spacequalifierrest);
  if (defined($metadata)) { return $metadata; }   if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
   
 # ---------------------------------------------- fourth, look in rest pf course  # ---------------------------------------------- fourth, look in rest of course
  if ($symbparm && defined($courseid) &&    if ($symbparm && defined($courseid) && 
     $courseid eq $env{'request.course.id'}) {      $courseid eq $env{'request.course.id'}) {
     my $coursereply=&resdata($env{'course.'.$courseid.'.num'},      my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
      $env{'course.'.$courseid.'.domain'},       $env{'course.'.$courseid.'.domain'},
      'course',       'course',
      ($courselevelm,$courselevel));       ([$courselevelm,'map'   ],
     if (defined($coursereply)) { return $coursereply; }        [$courselevel, 'course']));
       if (defined($coursereply)) { return &get_reply($coursereply); }
  }   }
 # ------------------------------------------------------------------ Cascade up  # ------------------------------------------------------------------ Cascade up
  unless ($space eq '0') {   unless ($space eq '0') {
Line 6642  sub EXT { Line 6715  sub EXT {
     my $id=pop(@parts);      my $id=pop(@parts);
     my $part=join('_',@parts);      my $part=join('_',@parts);
     if ($part eq '') { $part='0'; }      if ($part eq '') { $part='0'; }
     my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,      my @partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
  $symbparm,$udom,$uname,$section,1);   $symbparm,$udom,$uname,$section,1);
     if (defined($partgeneral)) { return $partgeneral; }      if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); }
  }   }
  if ($recurse) { return undef; }   if ($recurse) { return undef; }
  my $pack_def=&packages_tab_default($filename,$varname);   my $pack_def=&packages_tab_default($filename,$varname);
  if (defined($pack_def)) { return $pack_def; }   if (defined($pack_def)) { return &get_reply([$pack_def,'resource']); }
   
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {      } elsif ($realm eq 'environment') {
 # ----------------------------------------------------------------- environment  # ----------------------------------------------------------------- environment
Line 6677  sub EXT { Line 6749  sub EXT {
     return '';      return '';
 }  }
   
   sub get_reply {
       my ($reply_value) = @_;
       if (wantarray) {
    return @$reply_value;
       }
       return $reply_value->[0];
   }
   
 sub check_group_parms {  sub check_group_parms {
     my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;      my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;
     my @groupitems = ();      my @groupitems = ();
     my $resultitem;      my $resultitem;
     my @levels = ($symbparm,$mapparm,$what);      my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$what,'course']);
     foreach my $group (@{$groups}) {      foreach my $group (@{$groups}) {
         foreach my $level (@levels) {          foreach my $level (@levels) {
              my $item = $courseid.'.['.$group.'].'.$level;               my $item = $courseid.'.['.$group.'].'.$level->[0];
              push(@groupitems,$item);               push(@groupitems,[$item,$level->[1]]);
         }          }
     }      }
     my $coursereply = &resdata($env{'course.'.$courseid.'.num'},      my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
Line 6778  sub metadata { Line 6858  sub metadata {
     if (($uri eq '') ||       if (($uri eq '') || 
  (($uri =~ m|^/*adm/|) &&    (($uri =~ m|^/*adm/|) && 
      ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||       ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||          ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) ) {
  ($uri =~ m|home/$match_username/public_html/|)) {   return undef;
       }
       if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) 
    && &Apache::lonxml::get_state('target') =~ /^(|meta)$/) {
  return undef;   return undef;
     }      }
     my $filename=$uri;      my $filename=$uri;
Line 6800  sub metadata { Line 6883  sub metadata {
 # if (! exists($metacache{$uri})) {  # if (! exists($metacache{$uri})) {
 #    $metacache{$uri}={};  #    $metacache{$uri}={};
 # }  # }
    my $cachetime = 60*60;
         if ($liburi) {          if ($liburi) {
     $liburi=&declutter($liburi);      $liburi=&declutter($liburi);
             $filename=$liburi;              $filename=$liburi;
Line 6810  sub metadata { Line 6894  sub metadata {
         my %metathesekeys=();          my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }          unless ($filename=~/\.meta$/) { $filename.='.meta'; }
  my $metastring;   my $metastring;
  if ($uri !~ m -^(editupload)/-) {   if ($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) {
       my $which = &hreflocation('','/'.($liburi || $uri));
       $metastring = 
    &Apache::lonnet::ssi_body($which,
     ('grade_target' => 'meta'));
       $cachetime = 1; # only want this cached in the child not long term
    } elsif ($uri !~ m -^(editupload)/-) {
     my $file=&filelocation('',&clutter($filename));      my $file=&filelocation('',&clutter($filename));
     #push(@{$metaentry{$uri.'.file'}},$file);      #push(@{$metaentry{$uri.'.file'}},$file);
     $metastring=&getfile($file);      $metastring=&getfile($file);
Line 6977  sub metadata { Line 7067  sub metadata {
  $metaentry{':keys'} = join(',',keys(%metathesekeys));   $metaentry{':keys'} = join(',',keys(%metathesekeys));
  &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);   &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
  $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);   $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
  &do_cache_new('meta',$uri,\%metaentry,60*60);   &do_cache_new('meta',$uri,\%metaentry,$cachetime);
 # this is the end of "was not already recently cached  # this is the end of "was not already recently cached
     }      }
     return $metaentry{':'.$what};      return $metaentry{':'.$what};
Line 7925  sub filelocation { Line 8015  sub filelocation {
         }          }
     }      }
     $location=~s://+:/:g; # remove duplicate /      $location=~s://+:/:g; # remove duplicate /
     while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..      while ($location=~m{/\.\./}) {
    if ($location =~ m{/[^/]+/\.\./}) {
       $location=~ s{/[^/]+/\.\./}{/}g;
    } else {
       $location=~ s{/\.\./}{/}g;
    }
       } #remove dir/..
     while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./      while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./
     return $location;      return $location;
 }  }
Line 8791  explanation of a user role term Line 8887  explanation of a user role term
   
 =item *  =item *
   
 get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :  get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) :
 All arguments are optional. Returns a hash of a roles, either for  All arguments are optional. Returns a hash of a roles, either for
 co-author/assistant author roles for a user's Construction Space  co-author/assistant author roles for a user's Construction Space
 (default), or if $context is 'userroles', roles for the user himself,  (default), or if $context is 'userroles', roles for the user himself,
 In the hash, keys are set to colon-sparated $uname,$udom,and $role,  In the hash, keys are set to colon-separated $uname,$udom,$role, and
 and value is set to colon-separated start and end times for the role.  (optionally) if $withsec is true, a fourth colon-separated item - $section.
 If no username and domain are specified, will default to current  For each key, value is set to colon-separated start and end times for
 user/domain. Types, roles, and roledoms are references to arrays,  the role.  If no username and domain are specified, will default to
   current user/domain. Types, roles, and roledoms are references to arrays
 of role statuses (active, future or previous), roles   of role statuses (active, future or previous), roles 
 (e.g., cc,in, st etc.) and domains of the roles which can be used  (e.g., cc,in, st etc.) and domains of the roles which can be used
 to restrict the list of roles reported. If no array ref is   to restrict the list of roles reported. If no array ref is 
Removed from v.1.921  
changed lines
  Added in v.1.939

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