version 1.508, 2004/06/09 17:01:56
|
version 1.511, 2004/06/17 18:31:25
|
Line 1615 sub courseidput {
|
Line 1615 sub courseidput {
|
} |
} |
|
|
sub courseiddump { |
sub courseiddump { |
my ($domfilter,$descfilter,$sincefilter,$hostid)=@_; |
my ($domfilter,$descfilter,$sincefilter,$hostidflag,$hostidref)=@_; |
my %returnhash=(); |
my %returnhash=(); |
unless ($domfilter) { $domfilter=''; } |
unless ($domfilter) { $domfilter=''; } |
foreach my $tryserver (keys %libserv) { |
foreach my $tryserver (keys %libserv) { |
if (($hostid && $tryserver eq $hostid) || (!$hostid)) { |
if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) { |
if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) { |
if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) { |
foreach ( |
foreach ( |
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. |
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. |
Line 3057 sub log_query {
|
Line 3057 sub log_query {
|
# ------- Request retrieval of institutional classlists for course(s) |
# ------- Request retrieval of institutional classlists for course(s) |
|
|
sub fetch_enrollment_query { |
sub fetch_enrollment_query { |
my ($context,$affiliatesref,$replyref,$cnum,$dom) = @_; |
my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_; |
my $homeserver; |
my $homeserver; |
if ($context eq 'automated') { |
if ($context eq 'automated') { |
$homeserver = $perlvar{'lonHostID'}; |
$homeserver = $perlvar{'lonHostID'}; |
Line 3151 sub userlog_query {
|
Line 3151 sub userlog_query {
|
sub auto_run { |
sub auto_run { |
my ($cnum,$cdom) = @_; |
my ($cnum,$cdom) = @_; |
my $homeserver = &homeserver($cnum,$cdom); |
my $homeserver = &homeserver($cnum,$cdom); |
my $response = &reply('autorun',$homeserver); |
my $response = &reply('autorun:'.$cdom,$homeserver); |
return $response; |
return $response; |
} |
} |
|
|
Line 3159 sub auto_get_sections {
|
Line 3159 sub auto_get_sections {
|
my ($cnum,$cdom,$inst_coursecode) = @_; |
my ($cnum,$cdom,$inst_coursecode) = @_; |
my $homeserver = &homeserver($cnum,$cdom); |
my $homeserver = &homeserver($cnum,$cdom); |
my @secs = (); |
my @secs = (); |
my $response=&unescape(&reply('autogetsections:'.$inst_coursecode,$homeserver)); |
my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver)); |
unless ($response eq 'refused') { |
unless ($response eq 'refused') { |
@secs = split/:/,$response; |
@secs = split/:/,$response; |
} |
} |
Line 3169 sub auto_get_sections {
|
Line 3169 sub auto_get_sections {
|
sub auto_new_course { |
sub auto_new_course { |
my ($cnum,$cdom,$inst_course_id,$owner) = @_; |
my ($cnum,$cdom,$inst_course_id,$owner) = @_; |
my $homeserver = &homeserver($cnum,$cdom); |
my $homeserver = &homeserver($cnum,$cdom); |
my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner,$homeserver)); |
my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner,':'.$cdom,$homeserver)); |
return $response; |
return $response; |
} |
} |
|
|
sub auto_validate_courseID { |
sub auto_validate_courseID { |
my ($cnum,$cdom,$inst_course_id) = @_; |
my ($cnum,$cdom,$inst_course_id) = @_; |
my $homeserver = &homeserver($cnum,$cdom); |
my $homeserver = &homeserver($cnum,$cdom); |
my $response=&unescape(&reply('autovalidatecourse:'.$inst_course_id,$homeserver)); |
my $response=&unescape(&reply('autovalidatecourse:'.$inst_course_id.':'.$cdom,$homeserver)); |
return $response; |
return $response; |
} |
} |
|
|
Line 3185 sub auto_create_password {
|
Line 3185 sub auto_create_password {
|
my $homeserver = &homeserver($cnum,$cdom); |
my $homeserver = &homeserver($cnum,$cdom); |
my $create_passwd = 0; |
my $create_passwd = 0; |
my $authchk = ''; |
my $authchk = ''; |
my $response=&unescape(&reply('autocreatepassword:'.$authparam,$homeserver)); |
my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver)); |
if ($response eq 'refused') { |
if ($response eq 'refused') { |
$authchk = 'refused'; |
$authchk = 'refused'; |
} else { |
} else { |
Line 4370 sub symblist {
|
Line 4370 sub symblist {
|
# --------------------------------------------------------------- Verify a symb |
# --------------------------------------------------------------- Verify a symb |
|
|
sub symbverify { |
sub symbverify { |
my ($symb,$thisfn)=@_; |
my ($symb,$thisurl)=@_; |
|
my $thisfn=$thisurl; |
|
# wrapper not part of symbs |
|
$thisfn=~s/^\/adm\/wrapper//; |
$thisfn=&declutter($thisfn); |
$thisfn=&declutter($thisfn); |
# direct jump to resource in page or to a sequence - will construct own symbs |
# direct jump to resource in page or to a sequence - will construct own symbs |
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
Line 4380 sub symbverify {
|
Line 4383 sub symbverify {
|
unless ($url eq $thisfn) { return 0; } |
unless ($url eq $thisfn) { return 0; } |
|
|
$symb=&symbclean($symb); |
$symb=&symbclean($symb); |
|
$thisurl=&deversion($thisurl); |
$thisfn=&deversion($thisfn); |
$thisfn=&deversion($thisfn); |
|
|
my %bighash; |
my %bighash; |
Line 4387 sub symbverify {
|
Line 4391 sub symbverify {
|
|
|
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
my $ids=$bighash{'ids_'.&clutter($thisfn)}; |
my $ids=$bighash{'ids_'.&clutter($thisurl)}; |
unless ($ids) { |
unless ($ids) { |
$ids=$bighash{'ids_/'.$thisfn}; |
$ids=$bighash{'ids_/'.$thisurl}; |
} |
} |
if ($ids) { |
if ($ids) { |
# ------------------------------------------------------------------- Has ID(s) |
# ------------------------------------------------------------------- Has ID(s) |
Line 4420 sub symbclean {
|
Line 4424 sub symbclean {
|
|
|
# remove wrapper |
# remove wrapper |
|
|
$symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\//$1/; |
$symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/; |
return $symb; |
return $symb; |
} |
} |
|
|
Line 4976 sub declutter {
|
Line 4980 sub declutter {
|
|
|
sub clutter { |
sub clutter { |
my $thisfn='/'.&declutter(shift); |
my $thisfn='/'.&declutter(shift); |
unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv)\//) { |
unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv|public)\//) { |
$thisfn='/res'.$thisfn; |
$thisfn='/res'.$thisfn; |
} |
} |
return $thisfn; |
return $thisfn; |