[BACK]Return to LONCAPA.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/LONCAPA.pm between versions 1.19 and 1.33

version 1.19, 2006/12/09 23:33:56 version 1.33, 2011/11/07 20:05:52
Line 27 Line 27
 #  #
 ###  ###
   
   
   
 package LONCAPA;  package LONCAPA;
   
 use strict;  use strict;
Line 35  use LONCAPA::Configuration; Line 37  use LONCAPA::Configuration;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use GDBM_File;  use GDBM_File;
 use POSIX;  use POSIX;
   #use Apache::lonnet;
   
 my $loncapa_max_wait_time = 13;  my $loncapa_max_wait_time = 13;
   
   
   #--------------------------------------------------------------------------
   #
   #   The  constant definnitions below probably should really be in 
   #   a configuration file somewhere (loncapa.conf?) and loaded so that they can be 
   #   modified without requring source code changes:
   #
   #   COURSE_CACHE_TIME - Number of minutes after which an unaccessed
   #                       course.db or course_param.db file is considered
   #                       to be a stale cache of this info.
   #
   #   LONCAPA_TEMPDIR   - Place loncapa puts temporary files
   #
   
   my  $COURSE_CACHE_TIME =  60; # minutes course cache file is considered valid. 
   my  $LONCAPA_TEMPDIR   =  '/tmp/'; # relative to configuration{'lonTabDir'}.
   
 use vars qw($match_domain   $match_not_domain  use vars qw($match_domain   $match_not_domain
     $match_username $match_not_username      $match_username $match_not_username
     $match_courseid $match_not_courseid      $match_courseid $match_not_courseid
               $match_community
     $match_name      $match_name
               $match_lonid
     $match_handle   $match_not_handle);      $match_handle   $match_not_handle);
   
 require Exporter;  require Exporter;
 our @ISA = qw (Exporter);  our @ISA = qw (Exporter);
 our @EXPORT = qw(&add_get_param    &escape            &unescape         our @EXPORT = qw(&add_get_param    &escape            &unescape       
  &tie_domain_hash  &untie_domain_hash &tie_user_hash   &tie_domain_hash  &untie_domain_hash &tie_user_hash
  &untie_user_hash  &propath);   &untie_user_hash  &propath &tie_course);
 our @EXPORT_OK = qw($match_domain   $match_not_domain  our @EXPORT_OK = qw($match_domain   $match_not_domain
     $match_username $match_not_username      $match_username $match_not_username
     $match_courseid $match_not_courseid      $match_courseid $match_not_courseid
                       $match_community
     $match_name      $match_name
     $match_handle   $match_not_handle);      $match_lonid
       $match_handle   $match_not_handle &tie_course);
 our %EXPORT_TAGS = ( 'match' =>[qw($match_domain   $match_not_domain  our %EXPORT_TAGS = ( 'match' =>[qw($match_domain   $match_not_domain
    $match_username $match_not_username     $match_username $match_not_username
    $match_courseid $match_not_courseid     $match_courseid $match_not_courseid
                                      $match_community
    $match_name     $match_name
      $match_lonid
    $match_handle   $match_not_handle)],);     $match_handle   $match_not_handle)],);
 my %perlvar;  my %perlvar;
   
   
   #
   # If necessary fetch and tie a user's image of the course hash 
   # to the specified hash
   # Parameters:
   #   domain   - User's domain
   #   user     - Name of user.
   #   course   - Course number.
   #   cdom     - Domain that is home to the course
   #   hash     - reference to the has to tie.
   #
   # Side effects:
   #   a gdbm file and it's associated lock file will be created in the 
   #   tmp directory tree.
   #
   # Returns:
   #   0 - failure.
   #   1 - success.
   #
   #  Note:
   #     It's possible the required user's db file is already present in the tempdir.
   #     in that case a decision must be made about whether or not to just tie to it
   #     or to fetch it again. Remember this sub could be called in the context of a user
   #     other than the one whose data are being fetched.  We don't know if that user already
   #     has a live session on this server.  What we'll do is only re-fetch if the hash atime.
   #     is older than COURSE_CACHE_TIME...that is if it's been accessed relatively recently
   #     where COURSE_CACHE_TIME defines the caching time.
   #
   #     The database files this function creates are of the form:
   #     $user@$domain_$course@$cdom.{db,lock}
   #     This differs from the prior filenames.  Therefore if a module does its own
   #     caching (That's a coding no-no) and does not use this centralized sub,
   #     multiple cache files for the same course/user will be created. 
   #  
   sub tie_course {
       my ($domain, $user, $course, $cdom, $hash) = @_;
   
       #
       #  See if we need to re-fetch the course data
       #
   
 # Inputs are a url, and a hash ref of      
 # form name => value pairs  }
 # takes care of properly adding the form name elements and values to the   
 # the url doing proper escaping of the values and joining with ? or & as   # Return a string that is the path in which loncapa puts temp files:
 # needed  
   sub tempdir {
       my $result =  $perlvar{'lonDaemons'}.$LONCAPA_TEMPDIR; # to allow debugging.
       return $result;
   }
   
   
   #----------------------------------------------------------------------
   #
   #  some of these subs need a bit of documentation
   
 sub add_get_param {  sub add_get_param {
     my ($url,$form_data) = @_;      my ($url,$form_data) = @_;
Line 102  sub unescape { Line 175  sub unescape {
     return $str;      return $str;
 }  }
   
 $match_domain     = $LONCAPA::domain_re     = qr{[\w\-.]+};  $LONCAPA::assess_re = qr{\.(problem|exam|quiz|assess|survey|form|library|task)$};
 $match_not_domain = $LONCAPA::not_domain_re = qr{[^\w\-.]+};  $LONCAPA::assess_page_re = qr{\.(problem|exam|quiz|assess|survey|form|library|task|page)$};
   $LONCAPA::assess_page_seq_re = qr{\.(problem|exam|quiz|assess|survey|form|library|task|sequence|page)$};
   $LONCAPA::parse_re = qr{\.(problem|exam|quiz|assess|survey|form|library|page|xml|html|htm|xhtml|xhtm)$};
   $LONCAPA::parse_page_re = qr{\.(problem|exam|quiz|assess|survey|form|library|page|xml|html|htm|xhtml|xhtm|page)$};
   $LONCAPA::parse_page_sty_re = qr{\.(problem|exam|quiz|assess|survey|form|library|page|xml|html|htm|xhtml|xhtm|page|sty)$};
   
   
   $match_domain     = $LONCAPA::domain_re     = qr{[[:alnum:]\-.]+};
   $match_not_domain = $LONCAPA::not_domain_re = qr{[^[:alnum:]\-.]+};
 sub clean_domain {  sub clean_domain {
     my ($domain) = @_;      my ($domain) = @_;
     $domain =~ s/$match_not_domain//g;      $domain =~ s/$match_not_domain//g;
     return $domain;      return $domain;
 }  }
   
 $match_username     = $LONCAPA::username_re     = qr{[a-zA-Z\_][\w\-.]+};  $match_username     = $LONCAPA::username_re     = qr{\w[\w\-.@]+};
 $match_not_username = $LONCAPA::not_username_re = qr{[^\w\-.]+};  $match_not_username = $LONCAPA::not_username_re = qr{[^\w\-.@]+};
 sub clean_username {  sub clean_username {
     my ($username) = @_;      my ($username) = @_;
     $username =~ s/^\d+//;      $username =~ s/^\W+//;
     $username =~ s/$match_not_username//g;      $username =~ s/$match_not_username//g;
     return $username;      return $username;
 }  }
   
   
 $match_courseid     = $LONCAPA::courseid_re     = qr{\d[\w\-.]+};  $match_courseid     = $LONCAPA::courseid_re     = qr{\d[\w\-.]+};
   $match_community    =$LONCAPA::community_re     = qr{0[\w\-.]+};
 $match_not_courseid = $LONCAPA::not_courseid_re = qr{[^\w\-.]+};  $match_not_courseid = $LONCAPA::not_courseid_re = qr{[^\w\-.]+};
   sub clean_courseid {
       my ($courseid) = @_;
       $courseid =~ s/^\D+//;
       $courseid =~ s/$match_not_courseid//g;
       return $courseid;
   }
   
 $match_name         = $LONCAPA::name = qr{$match_username|$match_courseid};  $match_name         = $LONCAPA::name_re = qr{$match_username|$match_courseid};
 sub clean_name {  sub clean_name {
     my ($name) = @_;      my ($name) = @_;
     $name =~ s/$match_not_username//g;      $name =~ s/$match_not_username//g;
     return $name;      return $name;
 }  }
   
   $match_lonid     = $LONCAPA::lonid_re     = qr{[\w\-.]+};
   
 sub split_courseid {  sub split_courseid {
     my ($courseid) = @_;      my ($courseid) = @_;
     my  ($domain,$coursenum) =       my  ($domain,$coursenum) = 
Line 137  sub split_courseid { Line 227  sub split_courseid {
     return ($domain,$coursenum);      return ($domain,$coursenum);
 }  }
   
 $match_handle     = $LONCAPA::handle_re     = qr{[\w\-.]+};  $match_handle     = $LONCAPA::handle_re     = qr{[\w\-.@]+};
 $match_not_handle = $LONCAPA::not_handle_re = qr{[^\w\-.]+};  $match_not_handle = $LONCAPA::not_handle_re = qr{[^\w\-.@]+};
 sub clean_handle {  sub clean_handle {
     my ($handle) = @_;      my ($handle) = @_;
     $handle =~ s/$match_not_handle//g;      $handle =~ s/$match_not_handle//g;
     return $handle;      return $handle;
 }  }
   
   #
   # -- Ensure another process for same filesystem action is not running.
   #    lond uses for: apachereload; loncron uses for: lciptables
   #
   
   sub try_to_lock {
       my ($lockfile)=@_;
       my $currentpid;
       my $lastpid;
       # Do not manipulate lock file as root
       if ($>==0) {
           return 0;
       }
       # Try to generate lock file.
       # Wait 3 seconds.  If same process id is in
       # lock file, then assume lock file is stale, and
       # go ahead.  If process id's fluctuate, try
       # for a maximum of 10 times.
       for (0..10) {
           if (-e $lockfile) { 
               open(LOCK,"<$lockfile");
               $currentpid=<LOCK>;
               close LOCK;
               if ($currentpid==$lastpid) {
                   last;
               }
               sleep 3;
               $lastpid=$currentpid;
           } else {
               last;
           }
           if ($_==10) {
               return 0;
           }
       }
       open(LOCK,">$lockfile");
       print LOCK $$;
       close LOCK;
       return 1;
   }
   
 # -------------------------------------------- Return path to profile directory  # -------------------------------------------- Return path to profile directory
   
 sub propath {  sub propath {
Line 155  sub propath { Line 286  sub propath {
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;      $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";      my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
     return $proname;      return $proname;
 }   }
   
   
 #---------------------------------------------------------------  
 #  
 # Manipulation of hash based databases (factoring out common code  
 # for later use as we refactor.  
 #  
 #  Ties a domain level resource file to a hash.  
 #  If requested a history entry is created in the associated hist file.  
 #  
 #  Parameters:  
 #     domain    - Name of the domain in which the resource file lives.  
 #     namespace - Name of the hash within that domain.  
 #     how       - How to tie the hash (e.g. GDBM_WRCREAT()).  
 #     loghead   - Optional parameter, if present a log entry is created  
 #                 in the associated history file and this is the first part  
 #                  of that entry.  
 #     logtail   - Goes along with loghead,  The actual logentry is of the  
 #                 form $loghead:<timestamp>:logtail.  
 # Returns:  
 #    Reference to a hash bound to the db file or alternatively undef  
 #    if the tie failed.  
 #  
 sub tie_domain_hash {  sub tie_domain_hash {
     my ($domain,$namespace,$how,$loghead,$logtail) = @_;      my ($domain,$namespace,$how,$loghead,$logtail) = @_;
           
Line 197  sub tie_domain_hash { Line 306  sub tie_domain_hash {
 sub untie_domain_hash {  sub untie_domain_hash {
     return &_locking_hash_untie(@_);      return &_locking_hash_untie(@_);
 }  }
 #  
 #   Ties a user's resource file to a hash.    
 #   If necessary, an appropriate history  
 #   log file entry is made as well.  
 #   This sub factors out common code from the subs that manipulate  
 #   the various gdbm files that keep keyword value pairs.  
 # Parameters:  
 #   domain       - Name of the domain the user is in.  
 #   user         - Name of the 'current user'.  
 #   namespace    - Namespace representing the file to tie.  
 #   how          - What the tie is done to (e.g. GDBM_WRCREAT().  
 #   loghead      - Optional first part of log entry if there may be a  
 #                  history file.  
 #   what         - Optional tail of log entry if there may be a history  
 #                  file.  
 # Returns:  
 #   hash to which the database is tied.  It's up to the caller to untie.  
 #   undef if the has could not be tied.  
 #  
 sub tie_user_hash {  sub tie_user_hash {
     my ($domain,$user,$namespace,$how,$loghead,$what) = @_;      my ($domain,$user,$namespace,$how,$loghead,$what) = @_;
   
Line 230  sub untie_user_hash { Line 322  sub untie_user_hash {
     return &_locking_hash_untie(@_);      return &_locking_hash_untie(@_);
 }  }
   
 # routines if you just have a filename  
 # return tied hashref or undef  
   
 sub locking_hash_tie {  sub locking_hash_tie {
     my ($filename,$how)=@_;      my ($filename,$how)=@_;
Line 397  sub _do_hash_untie { Line 487  sub _do_hash_untie {
     }      }
 }  }
   
   
 BEGIN {  BEGIN {
     %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};      %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
 }  }
Line 409  __END__ Line 500  __END__
   
 =head1 NAME  =head1 NAME
   
   Apache::LONCAPA
   
 LONCAPA - Basic routines  LONCAPA - Basic routines
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
Line 417  Generally useful routines Line 510  Generally useful routines
   
 =head1 EXPORTED SUBROUTINES  =head1 EXPORTED SUBROUTINES
   
 =over 4  =over
   
 =item *  =item escape()
   
 escape() : unpack non-word characters into CGI-compatible hex codes  unpack non-word characters into CGI-compatible hex codes
   
 =item *  =item unescape()
   
 unescape() : pack CGI-compatible hex codes into actual non-word ASCII character   pack CGI-compatible hex codes into actual non-word ASCII character
   
 =item *  =item  add_get_param()
   
 add_get_param() :  Append escaped form elements (name=value etc.) to a url.
    
  Inputs:  url (with or without exit GET from parameters), hash ref of   Inputs:  url (with or without exit GET from parameters), hash ref of
               form name => value pairs                form name => value pairs
   
  Return: url with properly added the form name elements and values to the    Return: url with form name elements and values appended to the 
          the url doing proper escaping of the values and joining with ? or &           the url, doing proper escaping of the values and joining with ? or &
          as needed           as needed
   
   =item clean_handle()
   
   =item propath()
   
   =item untie_domain_hash()
   
   =item tie_domain_hash()
   
   Manipulation of hash based databases (factoring out common code
   for later use as we refactor.
   
    Ties a domain level resource file to a hash.
    If requested a history entry is created in the associated hist file.
   
    Parameters:
       domain    - Name of the domain in which the resource file lives.
       namespace - Name of the hash within that domain.
       how       - How to tie the hash (e.g. GDBM_WRCREAT()).
       loghead   - Optional parameter, if present a log entry is created
                   in the associated history file and this is the first part
                    of that entry.
       logtail   - Goes along with loghead,  The actual logentry is of the
                   form $loghead:<timestamp>:logtail.
   Returns:
      Reference to a hash bound to the db file or alternatively undef
      if the tie failed.
   
   =item tie_user_hash()
   
     Ties a user's resource file to a hash.  
     If necessary, an appropriate history
     log file entry is made as well.
     This sub factors out common code from the subs that manipulate
     the various gdbm files that keep keyword value pairs.
   Parameters:
     domain       - Name of the domain the user is in.
     user         - Name of the 'current user'.
     namespace    - Namespace representing the file to tie.
     how          - What the tie is done to (e.g. GDBM_WRCREAT().
     loghead      - Optional first part of log entry if there may be a
                    history file.
     what         - Optional tail of log entry if there may be a history
                    file.
   Returns:
     hash to which the database is tied.  It's up to the caller to untie.
     undef if the has could not be tied.
   
   =item tie_course
   
   Caches the course database into the temp directory in the context of a specific
   user and ties it to a hash.
   Parameters:
      domain    - Domain the user is in.
      user      - Username of the user.
      course    - Course specification
      cdom      - The course domain.
      hash      - Reference to the hash to tie.
   
   Returns:
       1        - Success
       0        - Failure.
   
   =item tie_course_params
   
   Caches the course parameter database into the temp directory in the context
   of a specific user and ties it to a hash.
   Parameters:
      domain   - Domain the user is in.
      user     - Username of the user.
      course   - course specification.
      cdom     - The course domain.
      hash     - reference to the hash to tie.
   
   Returns:
      1        - Success.
      0        - Failure./
   
   
   =item locking_hash_tie()
   
   routines if you just have a filename return tied hashref or undef
   
   =item locking_hash_untie()
   
   =item db_filename_parts()
   
   =back
   
   =item tempdir()
   
   Returns the file system path to the place loncapa temporary files should be placed/found.
   
   
   =head1 INTERNAL SUBROUTINES
   
   =over 
   
   =item _do_hash_tie()
   
   =item _do_hash_untie()
   
 =back  =back
   
   =cut
   
Removed from v.1.19  
changed lines
  Added in v.1.33

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