[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.375 and 1.398

version 1.375, 2003/05/21 15:24:20 version 1.398, 2003/08/06 17:00:30
Line 982  sub repcopy { Line 982  sub repcopy {
   
 # ------------------------------------------------ Get server side include body  # ------------------------------------------------ Get server side include body
 sub ssi_body {  sub ssi_body {
     my $filelink=shift;      my ($filelink,%form)=@_;
     my $output=($filelink=~/^http\:/?&externalssi($filelink):      my $output=($filelink=~/^http\:/?&externalssi($filelink):
                                      &ssi($filelink));                                       &ssi($filelink,%form));
     $output=~s/^.*\<body[^\>]*\>//si;      $output=~s/^.*\<body[^\>]*\>//si;
     $output=~s/\<\/body\s*\>.*$//si;      $output=~s/\<\/body\s*\>.*$//si;
     $output=~      $output=~
Line 1425  sub devalidate { Line 1425  sub devalidate {
     my ($symb,$uname,$udom)=@_;      my ($symb,$uname,$udom)=@_;
     my $cid=$ENV{'request.course.id'};       my $cid=$ENV{'request.course.id'}; 
     if ($cid) {      if ($cid) {
 # delete the stored spreadsheets for          # delete the stored spreadsheets for
 # - the student level sheet of this user in course's homespace          # - the student level sheet of this user in course's homespace
 # - the assessment level sheet for this resource           # - the assessment level sheet for this resource 
 #   for this user in user's homespace          #   for this user in user's homespace
  my $key=$uname.':'.$udom.':';   my $key=$uname.':'.$udom.':';
         my $status=          my $status=
     &del('nohist_calculatedsheets',      &del('nohist_calculatedsheets',
  [$key.'studentcalc'],   [$key.'studentcalc:'],
  $ENV{'course.'.$cid.'.domain'},   $ENV{'course.'.$cid.'.domain'},
  $ENV{'course.'.$cid.'.num'})   $ENV{'course.'.$cid.'.num'})
  .' '.   .' '.
     &del('nohist_calculatedsheets_'.$cid,      &del('nohist_calculatedsheets_'.$cid,
  [$key.'assesscalc:'.$symb]);   [$key.'assesscalc:'.$symb],$udom,$uname);
         unless ($status eq 'ok ok') {          unless ($status eq 'ok ok') {
            &logthis('Could not devalidate spreadsheet '.             &logthis('Could not devalidate spreadsheet '.
                     $uname.' at '.$udom.' for '.                      $uname.' at '.$udom.' for '.
Line 1643  sub tmpreset { Line 1643  sub tmpreset {
   my ($symb,$namespace,$domain,$stuname) = @_;    my ($symb,$namespace,$domain,$stuname) = @_;
   if (!$symb) {    if (!$symb) {
     $symb=&symbread();      $symb=&symbread();
     if (!$symb) { $symb= $ENV{'REQUEST_URI'}; }      if (!$symb) { $symb= $ENV{'request.url'}; }
   }    }
   $symb=escape($symb);    $symb=escape($symb);
   
Line 1936  sub rolesinit { Line 1936  sub rolesinit {
  my ($tdummy,$tdomain,$trest)=split(/\//,$area);   my ($tdummy,$tdomain,$trest)=split(/\//,$area);
  if ($trole =~ /^cr\//) {   if ($trole =~ /^cr\//) {
     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);      my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
     my $homsvr=homeserver($rauthor,$rdomain);       my $homsvr=homeserver($rauthor,$rdomain);
     if ($hostname{$homsvr} ne '') {      if ($hostname{$homsvr} ne '') {
  my $roledef=   my ($rdummy,$roledef)=
     reply("get:$rdomain:$rauthor:roles:rolesdef_$rrole",     &get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
   $homsvr);  
  if (($roledef ne 'con_lost') && ($roledef ne '')) {   if (($rdummy ne 'con_lost') && ($roledef ne '')) {
     my ($syspriv,$dompriv,$coursepriv)=      my ($syspriv,$dompriv,$coursepriv)=
  split(/\_/,unescape($roledef));   split(/\_/,$roledef);
     if (defined($syspriv)) {      if (defined($syspriv)) {
  $allroles{'cm./'}.=':'.$syspriv;   $allroles{'cm./'}.=':'.$syspriv;
  $allroles{$spec.'./'}.=':'.$syspriv;   $allroles{$spec.'./'}.=':'.$syspriv;
Line 2221  sub allowed { Line 2221  sub allowed {
     my $orguri=$uri;      my $orguri=$uri;
     $uri=&declutter($uri);      $uri=&declutter($uri);
   
       if (defined($ENV{'allowed.'.$priv})) { return $ENV{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources  # Free bre access to adm and meta resources
   
     if ((($uri=~/^adm\//) || ($uri=~/\.meta$/)) && ($priv eq 'bre')) {      if ((($uri=~/^adm\//) || ($uri=~/\.meta$/)) && ($priv eq 'bre')) {
Line 2521  sub is_on_map { Line 2522  sub is_on_map {
 sub definerole {  sub definerole {
   if (allowed('mcr','/')) {    if (allowed('mcr','/')) {
     my ($rolename,$sysrole,$domrole,$courole)=@_;      my ($rolename,$sysrole,$domrole,$courole)=@_;
     foreach (split('/',$sysrole)) {      foreach (split(':',$sysrole)) {
  my ($crole,$cqual)=split(/\&/,$_);   my ($crole,$cqual)=split(/\&/,$_);
         if ($pr{'cr:s'}!~/$crole/) { return "refused:s:$crole"; }          if ($pr{'cr:s'}!~/$crole/) { return "refused:s:$crole"; }
         if ($pr{'cr:s'}=~/$crole\&/) {          if ($pr{'cr:s'}=~/$crole\&/) {
Line 2530  sub definerole { Line 2531  sub definerole {
             }              }
         }          }
     }      }
     foreach (split('/',$domrole)) {      foreach (split(':',$domrole)) {
  my ($crole,$cqual)=split(/\&/,$_);   my ($crole,$cqual)=split(/\&/,$_);
         if ($pr{'cr:d'}!~/$crole/) { return "refused:d:$crole"; }          if ($pr{'cr:d'}!~/$crole/) { return "refused:d:$crole"; }
         if ($pr{'cr:d'}=~/$crole\&/) {          if ($pr{'cr:d'}=~/$crole\&/) {
Line 2539  sub definerole { Line 2540  sub definerole {
             }              }
         }          }
     }      }
     foreach (split('/',$courole)) {      foreach (split(':',$courole)) {
  my ($crole,$cqual)=split(/\&/,$_);   my ($crole,$cqual)=split(/\&/,$_);
         if ($pr{'cr:c'}!~/$crole/) { return "refused:c:$crole"; }          if ($pr{'cr:c'}!~/$crole/) { return "refused:c:$crole"; }
         if ($pr{'cr:c'}=~/$crole\&/) {          if ($pr{'cr:c'}=~/$crole\&/) {
Line 2651  sub assignrole { Line 2652  sub assignrole {
     my ($udom,$uname,$url,$role,$end,$start,$deleteflag)=@_;      my ($udom,$uname,$url,$role,$end,$start,$deleteflag)=@_;
     my $mrole;      my $mrole;
     if ($role =~ /^cr\//) {      if ($role =~ /^cr\//) {
  unless (&allowed('ccr',$url)) {          my $cwosec=$url;
           $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
    unless (&allowed('ccr',$cwosec)) {
            &logthis('Refused custom assignrole: '.             &logthis('Refused custom assignrole: '.
              $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.               $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
     $ENV{'user.name'}.' at '.$ENV{'user.domain'});      $ENV{'user.name'}.' at '.$ENV{'user.domain'});
Line 2732  sub modifyuser { Line 2735  sub modifyuser {
     my ($udom,    $uname, $uid,      my ($udom,    $uname, $uid,
         $umode,   $upass, $first,          $umode,   $upass, $first,
         $middle,  $last,  $gene,          $middle,  $last,  $gene,
         $forceid, $desiredhome)=@_;          $forceid, $desiredhome, $email)=@_;
     $udom=~s/\W//g;      $udom=~s/\W//g;
     $uname=~s/\W//g;      $uname=~s/\W//g;
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.      &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
Line 2774  sub modifyuser { Line 2777  sub modifyuser {
         }             }   
         $uhome=&homeserver($uname,$udom,'true');          $uhome=&homeserver($uname,$udom,'true');
         if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {          if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {
     return 'error: verify home';      return 'error: unable verify users home machine.';
         }          }
     }   # End of creation of new user      }   # End of creation of new user
 # ---------------------------------------------------------------------- Add ID  # ---------------------------------------------------------------------- Add ID
Line 2784  sub modifyuser { Line 2787  sub modifyuser {
        if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/)          if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/) 
          && (!$forceid)) {           && (!$forceid)) {
   unless ($uid eq $uidhash{$uname}) {    unless ($uid eq $uidhash{$uname}) {
       return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid;        return 'error: user id "'.$uid.'" does not match '.
                     'current user id "'.$uidhash{$uname}.'".';
           }            }
        } else {         } else {
   &idput($udom,($uname => $uid));    &idput($udom,($uname => $uid));
Line 2800  sub modifyuser { Line 2804  sub modifyuser {
     } else {      } else {
         %names = @tmp;          %names = @tmp;
     }      }
   #
   # Make sure to not trash student environment if instructor does not bother
   # to supply name and email information
   #
     if ($first)  { $names{'firstname'}  = $first; }      if ($first)  { $names{'firstname'}  = $first; }
     if ($middle) { $names{'middlename'} = $middle; }      if (defined($middle)) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }      if ($last)   { $names{'lastname'}   = $last; }
     if ($gene)   { $names{'generation'} = $gene; }      if (defined($gene))   { $names{'generation'} = $gene; }
       if ($email)  { $names{'notification'} = $email;
                      $names{'critnotification'} = $email; }
   
     my $reply = &put('environment', \%names, $udom,$uname);      my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }      if ($reply ne 'ok') { return 'error: '.$reply; }
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.      &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
Line 2817  sub modifyuser { Line 2828  sub modifyuser {
   
 sub modifystudent {  sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,      my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
         $end,$start,$forceid,$desiredhome)=@_;          $end,$start,$forceid,$desiredhome,$email)=@_;
     my $cid='';      my $cid='';
     unless ($cid=$ENV{'request.course.id'}) {      unless ($cid=$ENV{'request.course.id'}) {
  return 'not_in_class';   return 'not_in_class';
Line 2825  sub modifystudent { Line 2836  sub modifystudent {
 # --------------------------------------------------------------- Make the user  # --------------------------------------------------------------- Make the user
     my $reply=&modifyuser      my $reply=&modifyuser
  ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,   ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,
          $desiredhome);           $desiredhome,$email);
     unless ($reply eq 'ok') { return $reply; }      unless ($reply eq 'ok') { return $reply; }
     # This will cause &modify_student_enrollment to get the uid from the      # This will cause &modify_student_enrollment to get the uid from the
     # students environment      # students environment
Line 3060  sub dirlist { Line 3071  sub dirlist {
         }          }
         my $alldomstr='';          my $alldomstr='';
         foreach (sort keys %alldom) {          foreach (sort keys %alldom) {
             $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';              $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'/&domain:';
         }          }
         $alldomstr=~s/:$//;          $alldomstr=~s/:$//;
         return split(/:/,$alldomstr);                 return split(/:/,$alldomstr);       
Line 3185  sub courseresdata { Line 3196  sub courseresdata {
     return undef;      return undef;
 }  }
   
 # --------------------------------------------------------- Value of a Variable  #
   # EXT resource caching routines
   #
   
   sub clear_EXT_cache_status {
       &delenv('cache.EXT.');
   }
   
   sub EXT_cache_status {
       my ($target_domain,$target_user) = @_;
       my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;
       if (exists($ENV{$cachename}) && ($ENV{$cachename}+600) > time) {
           # We know already the user has no data
           return 1;
       } else {
           return 0;
       }
   }
   
   sub EXT_cache_set {
       my ($target_domain,$target_user) = @_;
       my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;
       &appenv($cachename => time);
   }
   
   # --------------------------------------------------------- Value of a Variable
 sub EXT {  sub EXT {
     my ($varname,$symbparm,$udom,$uname,)=@_;      my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
   
     unless ($varname) { return ''; }      unless ($varname) { return ''; }
     #get real user name/domain, courseid and symb      #get real user name/domain, courseid and symb
Line 3196  sub EXT { Line 3231  sub EXT {
     my $publicuser;      my $publicuser;
     if (!($uname && $udom)) {      if (!($uname && $udom)) {
       (my $cursymb,$courseid,$udom,$uname,$publicuser)=        (my $cursymb,$courseid,$udom,$uname,$publicuser)=
   &Apache::lonxml::whichuser();    &Apache::lonxml::whichuser($symbparm);
       if (!$symbparm) { $symbparm=$cursymb; }        if (!$symbparm) { $symbparm=$cursymb; }
     } else {      } else {
  $courseid=$ENV{'request.course.id'};   $courseid=$ENV{'request.course.id'};
Line 3273  sub EXT { Line 3308  sub EXT {
         }          }
     } elsif ($realm eq 'query') {      } elsif ($realm eq 'query') {
 # ---------------------------------------------- pull stuff out of query string  # ---------------------------------------------- pull stuff out of query string
         &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]);          &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  return $ENV{'form.'.$space};    [$spacequalifierrest]);
    return $ENV{'form.'.$spacequalifierrest}; 
    } elsif ($realm eq 'request') {     } elsif ($realm eq 'request') {
 # ------------------------------------------------------------- request.browser  # ------------------------------------------------------------- request.browser
         if ($space eq 'browser') {          if ($space eq 'browser') {
Line 3288  sub EXT { Line 3324  sub EXT {
         return $ENV{'course.'.$courseid.'.'.$spacequalifierrest};          return $ENV{'course.'.$courseid.'.'.$spacequalifierrest};
     } elsif ($realm eq 'resource') {      } elsif ($realm eq 'resource') {
   
    my $section;
  if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {   if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {
   
     #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;      #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
Line 3300  sub EXT { Line 3337  sub EXT {
     my $symbparm=$symbp.'.'.$spacequalifierrest;      my $symbparm=$symbp.'.'.$spacequalifierrest;
     my $mapparm=$mapp.'___(all).'.$spacequalifierrest;      my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
   
     my $section;  
     if (($ENV{'user.name'} eq $uname) &&      if (($ENV{'user.name'} eq $uname) &&
  ($ENV{'user.domain'} eq $udom)) {   ($ENV{'user.domain'} eq $udom)) {
  $section=$ENV{'request.course.sec'};   $section=$ENV{'request.course.sec'};
     } else {      } else {
  $section=&usection($udom,$uname,$courseid);                  if (! defined($usection)) {
                       $section=&usection($udom,$uname,$courseid);
                   } else {
                       $section = $usection;
                   }
     }      }
   
     my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;      my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
Line 3317  sub EXT { Line 3357  sub EXT {
     my $courselevelm=$courseid.'.'.$mapparm;      my $courselevelm=$courseid.'.'.$mapparm;
   
 # ----------------------------------------------------------- first, check user  # ----------------------------------------------------------- first, check user
     #most student don't have any data set, check if there is some data      #most student don\'t have any data set, check if there is some data
             #every thirty minutes              #every thirty minutes
     if (!      if (! &EXT_cache_status($udom,$uname)) {
  (exists($ENV{'cache.studentresdata'})  
     && (($ENV{'cache.studentresdata'}+1800) > time))) {  
  my %resourcedata=&get('resourcedata',   my %resourcedata=&get('resourcedata',
       [$courselevelr,$courselevelm,$courselevel],        [$courselevelr,$courselevelm,$courselevel],
       $udom,$uname);        $udom,$uname);
Line 3340  sub EXT { Line 3378  sub EXT {
  $uname." at ".$udom.": ".   $uname." at ".$udom.": ".
  $tmp."</font>");   $tmp."</font>");
     } elsif ($tmp=~/error:No such file/) {      } elsif ($tmp=~/error:No such file/) {
  $ENV{'cache.studentresdata'}=time;                          &EXT_cache_set($udom,$uname);
  &appenv(('cache.studentresdata'=>  
  $ENV{'cache.studentresdata'}));  
     } elsif ($tmp =~ /^(con_lost|no_such_host)/) {      } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
  return $tmp;   return $tmp;
     }      }
Line 3391  sub EXT { Line 3427  sub EXT {
     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);   $symbparm,$udom,$uname,$section,1);
     if (defined($partgeneral)) { return $partgeneral; }      if (defined($partgeneral)) { return $partgeneral; }
  }   }
    if ($recurse) { return undef; }
    my $pack_def=&packages_tab_default($filename,$varname);
    if (defined($pack_def)) { return $pack_def; }
   
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {      } elsif ($realm eq 'environment') {
Line 3414  sub EXT { Line 3453  sub EXT {
     return '';      return '';
 }  }
   
   sub packages_tab_default {
       my ($uri,$varname)=@_;
       my (undef,$part,$name)=split(/\./,$varname);
       my $packages=&metadata($uri,'packages');
       foreach my $package (split(/,/,$packages)) {
    my ($pack_type,$pack_part)=split(/_/,$package,2);
    if ($pack_part eq $part) {
       return $packagetab{"$pack_type&$name&default"};
    }
       }
       return undef;
   }
   
 sub add_prefix_and_part {  sub add_prefix_and_part {
     my ($prefix,$part)=@_;      my ($prefix,$part)=@_;
     my $keyroot;      my $keyroot;
Line 3482  sub metadata { Line 3534  sub metadata {
     foreach (keys %packagetab) {      foreach (keys %packagetab) {
  if ($_=~/^$package\&/) {   if ($_=~/^$package\&/) {
     my ($pack,$name,$subp)=split(/\&/,$_);      my ($pack,$name,$subp)=split(/\&/,$_);
       # ignore package.tab specified default values
                               # here &package_tab_default() will fetch those
       if ($subp eq 'default') { next; }
     my $value=$packagetab{$_};      my $value=$packagetab{$_};
     my $part=$keyroot;      my $part=$keyroot;
     $part=~s/^\_//;      $part=~s/^\_//;
Line 3489  sub metadata { Line 3544  sub metadata {
  $value.=' [Part: '.$part.']';   $value.=' [Part: '.$part.']';
     }      }
     my $unikey='parameter'.$keyroot.'_'.$name;      my $unikey='parameter'.$keyroot.'_'.$name;
     if ($subp eq 'default') {      $metacache{$uri.':'.$unikey.'.part'}=$part;
  $unikey='parameter_0_'.$name;      $metathesekeys{$unikey}=1;
  $metacache{$uri.':'.$unikey.'.part'}='0';  
     } else {  
  $metacache{$uri.':'.$unikey.'.part'}=$part;  
  $metathesekeys{$unikey}=1;  
     }  
     unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {      unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
  $metacache{$uri.':'.$unikey.'.'.$subp}=$value;   $metacache{$uri.':'.$unikey.'.'.$subp}=$value;
     }      }
Line 3628  sub gettitle { Line 3678  sub gettitle {
  unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }   unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
         return &metadata($urlsymb,'title');           return &metadata($urlsymb,'title'); 
     }      }
     if ($titlecache{$symb}) { return $titlecache{$symb}; }      if ($titlecache{$symb}) {
    if (time < ($titlecache{$symb}[1] + 600)) {
       return $titlecache{$symb}[0];
    } else {
       delete($titlecache{$symb});
    }
       }
     my ($map,$resid,$url)=split(/\_\_\_/,$symb);      my ($map,$resid,$url)=split(/\_\_\_/,$symb);
     my $title='';      my $title='';
     my %bighash;      my %bighash;
Line 3640  sub gettitle { Line 3696  sub gettitle {
     }      }
     $title=~s/\&colon\;/\:/gs;      $title=~s/\&colon\;/\:/gs;
     if ($title) {      if ($title) {
         $titlecache{$symb}=$title;          $titlecache{$symb}=[$title,time];
         return $title;          return $title;
     } else {      } else {
  return &metadata($urlsymb,'title');   return &metadata($urlsymb,'title');
Line 4061  BEGIN { Line 4117  BEGIN {
     %domain_auth_arg_def = ();      %domain_auth_arg_def = ();
     if ($fh) {      if ($fh) {
        while (<$fh>) {         while (<$fh>) {
            next if /^\#/;             next if (/^(\#|\s*$)/);
   #           next if /^\#/;
            chomp;             chomp;
            my ($domain, $domain_description, $def_auth, $def_auth_arg)             my ($domain, $domain_description, $def_auth, $def_auth_arg)
                = split(/:/,$_,4);                 = split(/:/,$_,4);
Line 4204  being set. Line 4261  being set.
   
 =back  =back
   
 =head1 INTRODUCTION  =head1 OVERVIEW
   
 This module provides subroutines which interact with the  lonnet provides subroutines which interact with the
 lonc/lond (TCP) network layer of LON-CAPA. And Can be used to ask about   lonc/lond (TCP) network layer of LON-CAPA. They can be used to ask
 - classes  about classes, users, and resources.
 - users   
 - resources  
   
 For many of these objects you can also use this to store data about  For many of these objects you can also use this to store data about
 them or modify them in various ways.  them or modify them in various ways.
   
 This is part of the LearningOnline Network with CAPA project  =head2 Symbs
 described at http://www.lon-capa.org.  
   
 =head1 RETURN MESSAGES  To identify a specific instance of a resource, LON-CAPA uses symbols
   or "symbs"X<symb>. These identifiers are built from the URL of the
   map, the resource number of the resource in the map, and the URL of
   the resource itself. The latter is somewhat redundant, but might help
   if maps change.
   
 =over 4  An example is
   
 =item *   msu/korte/parts/part1.sequence___19___msu/korte/tests/part12.problem
   
 con_lost : unable to contact remote host  The respective map entry is
   
 =item *   <resource id="19" src="/res/msu/korte/tests/part12.problem"
     title="Problem 2">
    </resource>
   
 con_delayed : unable to contact remote host, message will be delivered  Symbs are used by the random number generator, as well as to store and
 when the connection is brought back up  restore data specific to a certain instance of for example a problem.
   
 =item *  =head2 Storing And Retrieving Data
   
 con_failed : unable to contact remote host and unable to save message  X<store()>X<cstore()>X<restore()>Three of the most important functions
 for later delivery  in C<lonnet.pm> are C<&Apache::lonnet::cstore()>,
   C<&Apache::lonnet:restore()>, and C<&Apache::lonnet::store()>, which
   is is the non-critical message twin of cstore. These functions are for
   handlers to store a perl hash to a user's permanent data space in an
   easy manner, and to retrieve it again on another call. It is expected
   that a handler would use this once at the beginning to retrieve data,
   and then again once at the end to send only the new data back.
   
 =item *  The data is stored in the user's data directory on the user's
   homeserver under the ID of the course.
   
 error: : an error a occured, a description of the error follows the :  The hash that is returned by restore will have all of the previous
   value for all of the elements of the hash.
   
 =item *  Example:
   
    #creating a hash
    my %hash;
    $hash{'foo'}='bar';
   
    #storing it
    &Apache::lonnet::cstore(\%hash);
   
    #changing a value
    $hash{'foo'}='notbar';
   
    #adding a new value
    $hash{'bar'}='foo';
    &Apache::lonnet::cstore(\%hash);
   
    #retrieving the hash
    my %history=&Apache::lonnet::restore();
   
    #print the hash
    foreach my $key (sort(keys(%history))) {
      print("\%history{$key} = $history{$key}");
    }
   
   Will print out:
   
    %history{1:foo} = bar
    %history{1:keys} = foo:timestamp
    %history{1:timestamp} = 990455579
    %history{2:bar} = foo
    %history{2:foo} = notbar
    %history{2:keys} = foo:bar:timestamp
    %history{2:timestamp} = 990455580
    %history{bar} = foo
    %history{foo} = notbar
    %history{timestamp} = 990455580
    %history{version} = 2
   
   Note that the special hash entries C<keys>, C<version> and
   C<timestamp> were added to the hash. C<version> will be equal to the
   total number of versions of the data that have been stored. The
   C<timestamp> attribute will be the UNIX time the hash was
   stored. C<keys> is available in every historical section to list which
   keys were added or changed at a specific historical revision of a
   hash.
   
   B<Warning>: do not store the hash that restore returns directly. This
   will cause a mess since it will restore the historical keys as if the
   were new keys. I.E. 1:foo will become 1:1:foo etc.
   
   Calling convention:
   
    my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname,$home);
    &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$home);
   
   For more detailed information, see lonnet specific documentation.
   
   =head1 RETURN MESSAGES
   
   =over 4
   
   =item * B<con_lost>: unable to contact remote host
   
 no_such_host : unable to fund a host associated with the user/domain  =item * B<con_delayed>: unable to contact remote host, message will be delivered
   when the connection is brought back up
   
   =item * B<con_failed>: unable to contact remote host and unable to save message
   for later delivery
   
   =item * B<error:>: an error a occured, a description of the error follows the :
   
   =item * B<no_such_host>: unable to fund a host associated with the user/domain
 that was requested  that was requested
   
 =back  =back
Line 4253  that was requested Line 4390  that was requested
   
 =over 4  =over 4
   
 =item *  =item * 
   X<appenv()>
 appenv(%hash) : the value of %hash is written to the user envirnoment  B<appenv(%hash)>: the value of %hash is written to
 file, and will be restored for each access this user makes during this  the user envirnoment file, and will be restored for each access this
 session, also modifies the %ENV for the current process  user makes during this session, also modifies the %ENV for the current
   process
   
 =item *  =item *
   X<delenv()>
 delenv($regexp) : removes all items from the session environment file that matches the regular expression in $regexp. The values are also delted from the current processes %ENV.  B<delenv($regexp)>: removes all items from the session
   environment file that matches the regular expression in $regexp. The
   values are also delted from the current processes %ENV.
   
 =back  =back
   
Line 4270  delenv($regexp) : removes all items from Line 4410  delenv($regexp) : removes all items from
 =over 4  =over 4
   
 =item *  =item *
   X<queryauthenticate()>
 queryauthenticate($uname,$udom) : try to determine user's current  B<queryauthenticate($uname,$udom)>: try to determine user's current 
 authentication scheme  authentication scheme
   
 =item *  =item *
   X<authenticate()>
 authenticate($uname,$upass,$udom) : try to authenticate user from domain's lib  B<authenticate($uname,$upass,$udom)>: try to
 servers (first use the current one), $upass should be the users password  authenticate user from domain's lib servers (first use the current
   one). C<$upass> should be the users password.
   
 =item *  =item *
   X<homeserver()>
 homeserver($uname,$udom) : find the server which has the user's  B<homeserver($uname,$udom)>: find the server which has
 directory and files (there must be only one), this caches the answer,  the user's directory and files (there must be only one), this caches
 and also caches if there is a borken connection.  the answer, and also caches if there is a borken connection.
   
 =item *  =item *
   X<idget()>
 idget($udom,@ids) : find the usernames behind a list of IDs (IDs are a  B<idget($udom,@ids)>: find the usernames behind a list of IDs
 unique resource in a domain, there must be only 1 ID per username, and  (IDs are a unique resource in a domain, there must be only 1 ID per
 only 1 username per ID in a specific domain) (returns hash:  username, and only 1 username per ID in a specific domain) (returns
 id=>name,id=>name)  hash: id=>name,id=>name)
   
 =item *  =item *
   X<idrget()>
 idrget($udom,@unames) : find the IDs behind a list of usernames (returns hash:  B<idrget($udom,@unames)>: find the IDs behind a list of
 name=>id,name=>id)  usernames (returns hash: name=>id,name=>id)
   
 =item *  =item *
   X<idput()>
 idput($udom,%ids) : store away a list of names and associated IDs  B<idput($udom,%ids)>: store away a list of names and associated IDs
   
 =item *  =item *
   X<rolesinit()>
 rolesinit($udom,$username,$authhost) : get user privileges  B<rolesinit($udom,$username,$authhost)>: get user privileges
   
 =item *  =item *
   X<usection()>
 usection($udom,$uname,$cname) : finds the section of student in the  B<usection($udom,$uname,$cname)>: finds the section of student in the
 course $cname, return section name/number or '' for "not in course"  course $cname, return section name/number or '' for "not in course"
 and '-1' for "no section"  and '-1' for "no section"
   
 =item *  =item *
   X<userenvironment()>
 userenvironment($udom,$uname,@what) : gets the values of the keys  B<userenvironment($udom,$uname,@what)>: gets the values of the keys
 passed in @what from the requested user's environment, returns a hash  passed in @what from the requested user's environment, returns a hash
   
 =back  =back
Removed from v.1.375  
changed lines
  Added in v.1.398

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