version 1.21, 2006/12/10 23:06:13
|
version 1.27, 2008/11/20 15:19:33
|
Line 27
|
Line 27
|
# |
# |
### |
### |
|
|
|
|
|
|
package LONCAPA; |
package LONCAPA; |
|
|
use strict; |
use strict; |
Line 43 use vars qw($match_domain $match_not_d
|
Line 45 use vars qw($match_domain $match_not_d
|
$match_username $match_not_username |
$match_username $match_not_username |
$match_courseid $match_not_courseid |
$match_courseid $match_not_courseid |
$match_name |
$match_name |
|
$match_lonid |
$match_handle $match_not_handle); |
$match_handle $match_not_handle); |
|
|
require Exporter; |
require Exporter; |
Line 54 our @EXPORT_OK = qw($match_domain $mat
|
Line 57 our @EXPORT_OK = qw($match_domain $mat
|
$match_username $match_not_username |
$match_username $match_not_username |
$match_courseid $match_not_courseid |
$match_courseid $match_not_courseid |
$match_name |
$match_name |
|
$match_lonid |
$match_handle $match_not_handle); |
$match_handle $match_not_handle); |
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_name |
$match_name |
|
$match_lonid |
$match_handle $match_not_handle)],); |
$match_handle $match_not_handle)],); |
my %perlvar; |
my %perlvar; |
|
|
|
|
|
=pod |
|
|
|
=head2 NOTE: |
|
|
|
add_get_param() |
|
|
|
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 |
|
needed |
|
|
# Inputs are a url, and a hash ref of |
=cut |
# 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 |
|
# needed |
|
|
|
sub add_get_param { |
sub add_get_param { |
my ($url,$form_data) = @_; |
my ($url,$form_data) = @_; |
Line 110 sub clean_domain {
|
Line 122 sub clean_domain {
|
return $domain; |
return $domain; |
} |
} |
|
|
$match_username = $LONCAPA::username_re = qr{\w[\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/^\W+//; |
$username =~ s/^\W+//; |
Line 122 sub clean_username {
|
Line 134 sub clean_username {
|
|
|
$match_courseid = $LONCAPA::courseid_re = qr{\d[\w\-.]+}; |
$match_courseid = $LONCAPA::courseid_re = qr{\d[\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 157 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; |
Line 158 sub propath {
|
Line 178 sub propath {
|
} |
} |
|
|
|
|
#--------------------------------------------------------------- |
|
# |
|
# 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 196 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 212 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 405 BEGIN {
|
Line 385 BEGIN {
|
|
|
__END__ |
__END__ |
|
|
=pod |
|
|
|
=head1 NAME |
=head1 NAME |
|
|
|
Apache::LONCAPA |
|
|
LONCAPA - Basic routines |
LONCAPA - Basic routines |
|
|
=head1 SYNOPSIS |
=head1 SYNOPSIS |
Line 417 Generally useful routines
|
Line 398 Generally useful routines
|
|
|
=head1 EXPORTED SUBROUTINES |
=head1 EXPORTED SUBROUTINES |
|
|
=over 4 |
=over |
|
|
=item * |
|
|
|
escape() : unpack non-word characters into CGI-compatible hex codes |
=item escape() |
|
|
=item * |
unpack non-word characters into CGI-compatible hex codes |
|
|
unescape() : pack CGI-compatible hex codes into actual non-word ASCII character |
=item unescape() |
|
|
=item * |
pack CGI-compatible hex codes into actual non-word ASCII character |
|
|
add_get_param() : |
=item add_get_param() |
|
|
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 |
|
|
Line 437 add_get_param() :
|
Line 417 add_get_param() :
|
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 locking_hash_tie() |
|
|
|
routines if you just have a filename return tied hashref or undef |
|
|
|
=item locking_hash_untie() |
|
|
|
=item db_filename_parts() |
|
|
|
=head1 INTERNAL SUBROUTINES |
|
|
|
=item _do_hash_tie() |
|
|
|
=item _do_hash_untie() |
|
|
=back |
=back |
|
|
|
=cut |
|
|