version 1.960, 2008/06/06 04:53:51
|
version 1.963, 2008/07/17 21:22:51
|
Line 1890 sub process_coursefile {
|
Line 1890 sub process_coursefile {
|
print $fh $env{'form.'.$source}; |
print $fh $env{'form.'.$source}; |
close($fh); |
close($fh); |
if ($parser eq 'parse') { |
if ($parser eq 'parse') { |
my $parse_result = &extract_embedded_items($filepath,$fname,$allfiles,$codebase); |
my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase); |
unless ($parse_result eq 'ok') { |
unless ($parse_result eq 'ok') { |
&logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result); |
&logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result); |
} |
} |
Line 2098 sub finishuserfileupload {
|
Line 2098 sub finishuserfileupload {
|
close(FH); |
close(FH); |
} |
} |
if ($parser eq 'parse') { |
if ($parser eq 'parse') { |
my $parse_result = &extract_embedded_items($filepath,$file,$allfiles, |
my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles, |
$codebase); |
$codebase); |
unless ($parse_result eq 'ok') { |
unless ($parse_result eq 'ok') { |
&logthis('Failed to parse '.$filepath.$file. |
&logthis('Failed to parse '.$filepath.$file. |
Line 2138 sub finishuserfileupload {
|
Line 2138 sub finishuserfileupload {
|
} |
} |
|
|
sub extract_embedded_items { |
sub extract_embedded_items { |
my ($filepath,$file,$allfiles,$codebase,$content) = @_; |
my ($fullpath,$allfiles,$codebase,$content) = @_; |
my @state = (); |
my @state = (); |
my %javafiles = ( |
my %javafiles = ( |
codebase => '', |
codebase => '', |
Line 2153 sub extract_embedded_items {
|
Line 2153 sub extract_embedded_items {
|
if ($content) { |
if ($content) { |
$p = HTML::LCParser->new($content); |
$p = HTML::LCParser->new($content); |
} else { |
} else { |
$p = HTML::LCParser->new($filepath.'/'.$file); |
$p = HTML::LCParser->new($fullpath); |
} |
} |
while (my $t=$p->get_token()) { |
while (my $t=$p->get_token()) { |
if ($t->[0] eq 'S') { |
if ($t->[0] eq 'S') { |
Line 2766 sub courseidput {
|
Line 2766 sub courseidput {
|
sub courseiddump { |
sub courseiddump { |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$selfenrollonly,$catfilter)=@_; |
$selfenrollonly,$catfilter,$showhidden,$caller)=@_; |
my $as_hash = 1; |
my $as_hash = 1; |
my %returnhash; |
my %returnhash; |
if (!$domfilter) { $domfilter=''; } |
if (!$domfilter) { $domfilter=''; } |
Line 2784 sub courseiddump {
|
Line 2784 sub courseiddump {
|
&escape($instcodefilter).':'.&escape($ownerfilter). |
&escape($instcodefilter).':'.&escape($ownerfilter). |
':'.&escape($coursefilter).':'.&escape($typefilter). |
':'.&escape($coursefilter).':'.&escape($typefilter). |
':'.&escape($regexp_ok).':'.$as_hash.':'. |
':'.&escape($regexp_ok).':'.$as_hash.':'. |
&escape($selfenrollonly).':'.&escape($catfilter),$tryserver); |
&escape($selfenrollonly).':'.&escape($catfilter).':'. |
|
$showhidden.':'.$caller,$tryserver); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
my ($key,$value)=split(/\=/,$item,2); |
my ($key,$value)=split(/\=/,$item,2); |
Line 5557 sub modifyuser {
|
Line 5558 sub modifyuser {
|
my ($udom, $uname, $uid, |
my ($udom, $uname, $uid, |
$umode, $upass, $first, |
$umode, $upass, $first, |
$middle, $last, $gene, |
$middle, $last, $gene, |
$forceid, $desiredhome, $email)=@_; |
$forceid, $desiredhome, $email, $inststatus)=@_; |
$udom= &LONCAPA::clean_domain($udom); |
$udom= &LONCAPA::clean_domain($udom); |
$uname=&LONCAPA::clean_username($uname); |
$uname=&LONCAPA::clean_username($uname); |
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
Line 5618 sub modifyuser {
|
Line 5619 sub modifyuser {
|
# -------------------------------------------------------------- Add names, etc |
# -------------------------------------------------------------- Add names, etc |
my @tmp=&get('environment', |
my @tmp=&get('environment', |
['firstname','middlename','lastname','generation','id', |
['firstname','middlename','lastname','generation','id', |
'permanentemail'], |
'permanentemail','inststatus'], |
$udom,$uname); |
$udom,$uname); |
my %names; |
my %names; |
if ($tmp[0] =~ m/^error:.*/) { |
if ($tmp[0] =~ m/^error:.*/) { |
Line 5636 sub modifyuser {
|
Line 5637 sub modifyuser {
|
if (defined($gene)) { $names{'generation'} = $gene; } |
if (defined($gene)) { $names{'generation'} = $gene; } |
if ($email) { |
if ($email) { |
$email=~s/[^\w\@\.\-\,]//gs; |
$email=~s/[^\w\@\.\-\,]//gs; |
if ($email=~/\@/) { $names{'notification'} = $email; |
if ($email=~/\@/) { $names{'permanentemail'} = $email; } |
$names{'critnotification'} = $email; |
|
$names{'permanentemail'} = $email; } |
|
} |
} |
if ($uid) { $names{'id'} = $uid; } |
if ($uid) { $names{'id'} = $uid; } |
|
if (defined($inststatus)) { $names{'inststatus'} = $inststatus; } |
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; } |
my $sqlresult = &update_allusers_table($uname,$udom,\%names); |
my $sqlresult = &update_allusers_table($uname,$udom,\%names); |
&devalidate_cache_new('namescache',$uname.':'.$udom); |
&devalidate_cache_new('namescache',$uname.':'.$udom); |
&logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. |
my $logmsg = 'Success modifying user '.$udom.', '.$uname.', '.$uid.', '. |
$umode.', '.$first.', '.$middle.', '. |
$umode.', '.$first.', '.$middle.', '. |
$last.', '.$gene.' by '. |
$last.', '.$gene.', '.$email.', '.$inststatus; |
$env{'user.name'}.' at '.$env{'user.domain'}); |
if ($env{'user.name'} ne '' && $env{'user.domain'}) { |
|
$logmsg .= ' by '.$env{'user.name'}.' at '.$env{'user.domain'}; |
|
} else { |
|
$logmsg .= ' during self creation'; |
|
} |
|
&logthis($logmsg); |
return 'ok'; |
return 'ok'; |
} |
} |
|
|
Line 9146 modifyuserauth($udom,$uname,$umode,$upas
|
Line 9151 modifyuserauth($udom,$uname,$umode,$upas
|
|
|
=item * |
=item * |
|
|
modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene) : |
modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene, |
|
$forceid,$desiredhome,$email,$inststatus) : |
modify user |
modify user |
|
|
=item * |
=item * |
Line 9197 Inputs:
|
Line 9203 Inputs:
|
|
|
=item B<$type> Type of enrollment (auto or manual) |
=item B<$type> Type of enrollment (auto or manual) |
|
|
=item B<$locktype> |
=item B<$locktype> boolean - enrollment type locked to prevent Autoenroll.pl changing manual to auto |
|
|
|
=item B<$cid> courseID - needed if a course role is assigned by a user whose current role is DC |
|
|
=item B<$cid> |
=item B<$selfenroll> boolean - 1 if user role change occurred via self-enrollment |
|
|
=item B<$selfenroll> |
=item B<$context> role change context (shown in User Management Logs display in a course) |
|
|
=item B<$context> |
=item B<$inststatus> institutional status of user - : separated string of escaped status types |
|
|
=back |
=back |
|
|