generation
+ no_inline_link -> if true and in remote mode, don't show the
+ 'Switch To Inline Menu' link
no_auto_mt_title -> prevent &mt()ing the title arg
inherit_jsmath -> when creating popup window in a page,
should it have jsmath forced on by the
current page
bread_crumbs -> Array containing breadcrumbs
bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
+ group -> includes the current group, if page is for a
+ specific group
=back
@@ -6880,7 +7503,7 @@ sub start_page {
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
$env{'internal.start_page'}++;
- my $result;
+ my ($result,@advtools);
if (! exists($args->{'skip_phases'}{'head'}) ) {
$result .= &xml_begin() . &headtag($title, $head_extra, $args);
@@ -6897,7 +7520,8 @@ sub start_page {
$args->{'function'}, $args->{'add_entries'},
$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'no_nav_bar'},
- $args->{'bgcolor'}, $args);
+ $args->{'bgcolor'}, $args->{'no_inline_link'},
+ $args, \@advtools);
}
}
@@ -6926,6 +7550,10 @@ sub start_page {
&Apache::lonhtmlcommon::add_breadcrumb($crumb);
}
}
+ # if @advtools array contains items add then to the breadcrumbs
+ if (@advtools > 0) {
+ &Apache::lonmenu::advtools_crumbs(@advtools);
+ }
#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
if(exists($args->{'bread_crumbs_component'})){
@@ -6933,6 +7561,11 @@ sub start_page {
}else{
$result .= &Apache::lonhtmlcommon::breadcrumbs();
}
+ } elsif (($env{'environment.remote'} eq 'on') &&
+ ($env{'form.inhibitmenu'} ne 'yes') &&
+ ($env{'request.noversionuri'} =~ m{^/res/}) &&
+ ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
+ $result .= '
';
}
return $result;
}
@@ -6954,7 +7587,9 @@ sub end_page {
} else {
$result .= &endbodytag($args);
}
- $result .= "\n";
+ unless ($args->{'notbody'}) {
+ $result .= "\n";
+ }
if ($args->{'js_ready'}) {
$result = &js_ready($result);
@@ -6969,7 +7604,7 @@ sub end_page {
sub wishlist_window {
return(<<'ENDWISHLIST');
-
@@ -7177,20 +7821,21 @@ ENDPROGRESSUPDATE
}
my $LClastpercent;
+my $LCidcnt;
+my $LCcurrentid;
sub LCprogressbar {
my ($r)=(@_);
$LClastpercent=0;
+ $LCidcnt++;
+ $LCcurrentid=$$.'_'.$LCidcnt;
my $starting=&mt('Starting');
my $content=(<
-
+
$starting
-
ENDPROGBAR
- $r->print($content.&LCprogressbar_script());
- $r->rflush();
+ &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
}
sub LCprogressbarUpdate {
@@ -7207,27 +7852,35 @@ sub LCprogressbarUpdate {
$LClastpercent=$val;
unless ($text) { $text=$val.'%'; }
$text=&js_ready($text);
- $r->print(<
//
ENDUPDATE
- $r->rflush();
}
sub LCprogressbarClose {
my ($r)=@_;
$LClastpercent=0;
- $r->print(<
//
ENDCLOSE
- $r->rflush();
+}
+
+sub r_print {
+ my ($r,$to_print)=@_;
+ if ($r) {
+ $r->print($to_print);
+ $r->rflush();
+ } else {
+ print($to_print);
+ }
}
sub html_encode {
@@ -7237,6 +7890,7 @@ sub html_encode {
return $result;
}
+
sub js_ready {
my ($result) = @_;
@@ -7275,27 +7929,126 @@ sub validate_page {
sub start_scrollbox {
- my ($outerwidth,$width,$height,$id)=@_;
+ my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready)=@_;
unless ($outerwidth) { $outerwidth='520px'; }
unless ($width) { $width='500px'; }
unless ($height) { $height='200px'; }
- my ($table_id,$div_id);
+ my ($table_id,$div_id,$tdcol);
if ($id ne '') {
- $table_id = " id='table_$id'";
- $div_id = " id='div_$id'";
+ $table_id = ' id="table_'.$id.'"';
+ $div_id = ' id="div_'.$id.'"';
+ }
+ if ($bgcolor ne '') {
+ $tdcol = "background-color: $bgcolor;";
+ }
+ my $nicescroll_js;
+ if ($env{'browser.mobile'}) {
+ $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
}
- return "
'.
&Apache::loncommon::end_page();
if (ref($r)) {
$r->print($page);
@@ -7510,8 +8263,7 @@ role status: active, previous or future.
sub check_user_status {
my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
- my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
- my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);
+ my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
my @uroles = keys %userinfo;
my $srchstr;
my $active_chk = 'none';
@@ -7589,7 +8341,19 @@ sub get_sections {
my %sectioncount;
my $now = time;
- if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
+ my $check_students = 1;
+ my $only_students = 0;
+ if (ref($possible_roles) eq 'ARRAY') {
+ if (grep(/^st$/,@{$possible_roles})) {
+ if (@{$possible_roles} == 1) {
+ $only_students = 1;
+ }
+ } else {
+ $check_students = 0;
+ }
+ }
+
+ if ($check_students) {
my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
my $sec_index = &Apache::loncoursedata::CL_SECTION();
my $status_index = &Apache::loncoursedata::CL_STATUS();
@@ -7616,6 +8380,9 @@ sub get_sections {
}
}
}
+ if ($only_students) {
+ return %sectioncount;
+ }
my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
foreach my $user (sort(keys(%courseroles))) {
if ($user !~ /^(\w{2})/) { next; }
@@ -7763,7 +8530,7 @@ sub get_course_users {
active => 'Active',
future => 'Future',
);
- my %nothide;
+ my (%nothide,@possdoms);
if ($hidepriv) {
my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
@@ -7773,6 +8540,10 @@ sub get_course_users {
$nothide{$user} = 1;
}
}
+ my @possdoms = ($cdom);
+ if ($coursehash{'checkforpriv'}) {
+ push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
+ }
}
foreach my $person (sort(keys(%coursepersonnel))) {
my $match = 0;
@@ -7808,7 +8579,7 @@ sub get_course_users {
}
if ($uname ne '' && $udom ne '') {
if ($hidepriv) {
- if ((&Apache::lonnet::privileged($uname,$udom)) &&
+ if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
(!$nothide{$uname.':'.$udom})) {
next;
}
@@ -7896,11 +8667,16 @@ sub get_user_info {
=item * &get_user_quota()
-Retrieves quota assigned for storage of portfolio files for a user
+Retrieves quota assigned for storage of user files.
+Default is to report quota for portfolio files.
Incoming parameters:
1. user's username
2. user's domain
+3. quota name - portfolio, author, or course
+ (if no quota name provided, defaults to portfolio).
+4. crstype - official, unofficial or community, if quota name is
+ course
Returns:
1. Disk quota (in Mb) assigned to student.
@@ -7914,7 +8690,7 @@ Returns:
If a value has been stored in the user's environment,
it will return that, otherwise it returns the maximal default
-defined for the user's instituional status(es) in the domain.
+defined for the user's institutional status(es) in the domain.
=cut
@@ -7922,7 +8698,7 @@ defined for the user's instituional stat
sub get_user_quota {
- my ($uname,$udom) = @_;
+ my ($uname,$udom,$quotaname,$crstype) = @_;
my ($quota,$quotatype,$settingstatus,$defquota);
if (!defined($udom)) {
$udom = $env{'user.domain'};
@@ -7937,27 +8713,57 @@ sub get_user_quota {
$defquota = 0;
} else {
my $inststatus;
- if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
- $quota = $env{'environment.portfolioquota'};
- $inststatus = $env{'environment.inststatus'};
- } else {
- my %userenv =
- &Apache::lonnet::get('environment',['portfolioquota',
- 'inststatus'],$udom,$uname);
- my ($tmp) = keys(%userenv);
- if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
- $quota = $userenv{'portfolioquota'};
- $inststatus = $userenv{'inststatus'};
- } else {
- undef(%userenv);
- }
- }
- ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
- if ($quota eq '') {
- $quota = $defquota;
- $quotatype = 'default';
+ if ($quotaname eq 'course') {
+ if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
+ ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
+ $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
+ } else {
+ my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
+ $quota = $cenv{'internal.uploadquota'};
+ }
} else {
- $quotatype = 'custom';
+ if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
+ if ($quotaname eq 'author') {
+ $quota = $env{'environment.authorquota'};
+ } else {
+ $quota = $env{'environment.portfolioquota'};
+ }
+ $inststatus = $env{'environment.inststatus'};
+ } else {
+ my %userenv =
+ &Apache::lonnet::get('environment',['portfolioquota',
+ 'authorquota','inststatus'],$udom,$uname);
+ my ($tmp) = keys(%userenv);
+ if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+ if ($quotaname eq 'author') {
+ $quota = $userenv{'authorquota'};
+ } else {
+ $quota = $userenv{'portfolioquota'};
+ }
+ $inststatus = $userenv{'inststatus'};
+ } else {
+ undef(%userenv);
+ }
+ }
+ }
+ if ($quota eq '' || wantarray) {
+ if ($quotaname eq 'course') {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
+ if (($crstype eq 'official') || ($crstype eq 'unofficial') || ($crstype eq 'community')) {
+ $defquota = $domdefs{$crstype.'quota'};
+ }
+ if ($defquota eq '') {
+ $defquota = 500;
+ }
+ } else {
+ ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
+ }
+ if ($quota eq '') {
+ $quota = $defquota;
+ $quotatype = 'default';
+ } else {
+ $quotatype = 'custom';
+ }
}
}
if (wantarray) {
@@ -7977,14 +8783,18 @@ Retrieves default quota assigned for sto
given an (optional) user's institutional status.
Incoming parameters:
+
1. domain
2. (Optional) institutional status(es). This is a : separated list of
status types (e.g., faculty, staff, student etc.)
which apply to the user for whom the default is being retrieved.
If the institutional status string in undefined, the domain
- default quota will be returned.
+ default quota will be returned.
+3. quota name - portfolio, author, or course
+ (if no quota name provided, defaults to portfolio).
Returns:
+
1. Default disk quota (in Mb) for user portfolios in the domain.
2. (Optional) institutional type which determined the value of the
default quota.
@@ -7998,33 +8808,35 @@ If the user's status includes multiple t
the largest default quota which applies to the user determines the
default quota returned.
-=back
-
=cut
###############################################
sub default_quota {
- my ($udom,$inststatus) = @_;
+ my ($udom,$inststatus,$quotaname) = @_;
my ($defquota,$settingstatus);
my %quotahash = &Apache::lonnet::get_dom('configuration',
['quotas'],$udom);
+ my $key = 'defaultquota';
+ if ($quotaname eq 'author') {
+ $key = 'authorquota';
+ }
if (ref($quotahash{'quotas'}) eq 'HASH') {
if ($inststatus ne '') {
my @statuses = map { &unescape($_); } split(/:/,$inststatus);
foreach my $item (@statuses) {
- if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
- if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
+ if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
+ if ($quotahash{'quotas'}{$key}{$item} ne '') {
if ($defquota eq '') {
- $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
+ $defquota = $quotahash{'quotas'}{$key}{$item};
$settingstatus = $item;
- } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
- $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
+ } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
+ $defquota = $quotahash{'quotas'}{$key}{$item};
$settingstatus = $item;
}
}
- } else {
+ } elsif ($key eq 'defaultquota') {
if ($quotahash{'quotas'}{$item} ne '') {
if ($defquota eq '') {
$defquota = $quotahash{'quotas'}{$item};
@@ -8038,16 +8850,25 @@ sub default_quota {
}
}
if ($defquota eq '') {
- if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
- $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
- } else {
+ if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
+ $defquota = $quotahash{'quotas'}{$key}{'default'};
+ } elsif ($key eq 'defaultquota') {
$defquota = $quotahash{'quotas'}{'default'};
}
$settingstatus = 'default';
+ if ($defquota eq '') {
+ if ($quotaname eq 'author') {
+ $defquota = 500;
+ }
+ }
}
} else {
$settingstatus = 'default';
- $defquota = 20;
+ if ($quotaname eq 'author') {
+ $defquota = 500;
+ } else {
+ $defquota = 20;
+ }
}
if (wantarray) {
return ($defquota,$settingstatus);
@@ -8056,6 +8877,61 @@ sub default_quota {
}
}
+###############################################
+
+=pod
+
+=item * &excess_filesize_warning()
+
+Returns warning message if upload of file to authoring space, or copying
+of existing file within authoring space will cause quota for the authoring
+space to be exceeded.
+
+Same, if upload of a file directly to a course/community via Course Editor
+will cause quota for uploaded content for the course to be exceeded.
+
+Inputs: 6
+1. username or coursenum
+2. domain
+3. context ('author' or 'course')
+4. filename of file for which action is being requested
+5. filesize (kB) of file
+6. action being taken: copy or upload.
+
+Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
+ otherwise return null.
+
+=back
+
+=cut
+
+sub excess_filesize_warning {
+ my ($uname,$udom,$context,$filename,$filesize,$action) = @_;
+ my $current_disk_usage = 0;
+ my $disk_quota = &get_user_quota($uname,$udom,$context); #expressed in MB
+ if ($context eq 'author') {
+ my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
+ $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
+ } else {
+ foreach my $subdir ('docs','supplemental') {
+ $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
+ }
+ }
+ $disk_quota = int($disk_quota * 1000);
+ if (($current_disk_usage + $filesize) > $disk_quota) {
+ return '
'.
+ &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
+ ''.$filename.'',$filesize).''.
+ ' '.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
+ $disk_quota,$current_disk_usage).
+ '
';
+ }
+ return;
+}
+
+###############################################
+
+
sub get_secgrprole_info {
my ($cdom,$cnum,$needroles,$type) = @_;
my %sections_count = &get_sections($cdom,$cnum);
@@ -8413,7 +9289,10 @@ sub user_rule_formats {
my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
if (@{$ruleorder} > 0) {
- $output = ' '.&mt("$text{$check} with the following format(s) may only be used for verified users at [_1]:",$domdesc).'
';
+ $output = ' '.
+ &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
+ '','',$domdesc).
+ '
';
foreach my $rule (@{$ruleorder}) {
if (ref($curr_rules) eq 'ARRAY') {
if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
@@ -8742,6 +9621,8 @@ sub get_future_slots {
=pod
+=back
+
=head1 HTTP Helpers
=over 4
@@ -8880,21 +9761,37 @@ sub get_env_multiple {
sub ask_for_embedded_content {
my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
- my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);
- my $num = 0;
+ my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
+ %currsubfile,%unused,$rem);
+ my $counter = 0;
+ my $numnew = 0;
my $numremref = 0;
my $numinvalid = 0;
my $numpathchg = 0;
my $numexisting = 0;
- my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);
- if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ my $numunused = 0;
+ my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
+ $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
+ my $heading = &mt('Upload embedded files');
+ my $buttontext = &mt('Upload');
+
+ my ($navmap,$cdom,$cnum);
+ if ($env{'request.course.id'}) {
+ if ($actionurl eq '/adm/dependencies') {
+ $navmap = Apache::lonnavmaps::navmap->new();
+ }
+ $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ }
+ if (($actionurl eq '/adm/portfolio') ||
+ ($actionurl eq '/adm/coursegrp_portfolio')) {
my $current_path='/';
if ($env{'form.currentpath'}) {
$current_path = $env{'form.currentpath'};
}
if ($actionurl eq '/adm/coursegrp_portfolio') {
- $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
+ $udom = $cdom;
+ $uname = $cnum;
$url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
} else {
$udom = $env{'user.domain'};
@@ -8914,23 +9811,65 @@ sub ask_for_embedded_content {
}
} elsif ($actionurl eq '/adm/coursedocs') {
if (ref($args) eq 'HASH') {
- $url = $args->{'docs_url'};
- $toplevel = $url;
+ $url = $args->{'docs_url'};
+ $toplevel = $url;
+ if ($args->{'context'} eq 'paste') {
+ ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
+ ($path) =
+ ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
+ $fileloc = &Apache::lonnet::filelocation('',$toplevel);
+ $fileloc =~ s{^/}{};
+ }
+ }
+ } elsif ($actionurl eq '/adm/dependencies') {
+ if ($env{'request.course.id'} ne '') {
+ if (ref($args) eq 'HASH') {
+ $url = $args->{'docs_url'};
+ $title = $args->{'docs_title'};
+ $toplevel = $url;
+ unless ($toplevel =~ m{^/}) {
+ $toplevel = "/$url";
+ }
+ ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
+ if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
+ $path = $1;
+ } else {
+ ($path) =
+ ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
+ }
+ $fileloc = &Apache::lonnet::filelocation('',$toplevel);
+ $fileloc =~ s{^/}{};
+ ($filename) = ($fileloc =~ m{.+/([^/]+)$});
+ $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
+ }
+ }
+ } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
+ $udom = $cdom;
+ $uname = $cnum;
+ $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
+ $toplevel = $url;
+ $path = $url;
+ $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
+ $fileloc =~ s{^/}{};
+ }
+ foreach my $file (keys(%{$allfiles})) {
+ my $embed_file;
+ if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
+ $embed_file = $1;
+ } else {
+ $embed_file = $file;
}
- }
- my $now = time();
- foreach my $embed_file (keys(%{$allfiles})) {
my $absolutepath;
- if ($embed_file =~ m{^\w+://}) {
- $newfiles{$embed_file} = 1;
- $mapping{$embed_file} = $embed_file;
+ my $cleaned_file = &clean_path($embed_file);
+ if ($cleaned_file =~ m{^\w+://}) {
+ $newfiles{$cleaned_file} = 1;
+ $mapping{$cleaned_file} = $embed_file;
} else {
if ($embed_file =~ m{^/}) {
$absolutepath = $embed_file;
- $embed_file =~ s{^(/+)}{};
}
- if ($embed_file =~ m{/}) {
- my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
+ if ($cleaned_file =~ m{/}) {
+ my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
$path = &check_for_traversal($path,$url,$toplevel);
my $item = $fname;
if ($path ne '') {
@@ -8947,32 +9886,60 @@ sub ask_for_embedded_content {
} else {
$dependencies{$embed_file} = 1;
if ($absolutepath) {
- $mapping{$embed_file} = $absolutepath;
+ $mapping{$cleaned_file} = $absolutepath;
} else {
- $mapping{$embed_file} = $embed_file;
+ $mapping{$cleaned_file} = $embed_file;
}
}
}
}
+ my $dirptr = 16384;
foreach my $path (keys(%subdependencies)) {
- my %currsubfile;
- if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ $currsubfile{$path} = {};
+ if (($actionurl eq '/adm/portfolio') ||
+ ($actionurl eq '/adm/coursegrp_portfolio')) {
my ($sublistref,$listerror) =
&Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
if (ref($sublistref) eq 'ARRAY') {
foreach my $line (@{$sublistref}) {
my ($file_name,$rest) = split(/\&/,$line,2);
- $currsubfile{$file_name} = 1;
+ $currsubfile{$path}{$file_name} = 1;
}
}
} elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
if (opendir(my $dir,$url.'/'.$path)) {
my @subdir_list = grep(!/^\./,readdir($dir));
- map {$currsubfile{$_} = 1;} @subdir_list;
+ map {$currsubfile{$path}{$_} = 1;} @subdir_list;
+ }
+ } elsif (($actionurl eq '/adm/dependencies') ||
+ (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
+ ($args->{'context'} eq 'paste')) ||
+ ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
+ if ($env{'request.course.id'} ne '') {
+ my $dir;
+ if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
+ $dir = $fileloc;
+ } else {
+ ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
+ }
+ if ($dir ne '') {
+ my ($sublistref,$listerror) =
+ &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
+ if (ref($sublistref) eq 'ARRAY') {
+ foreach my $line (@{$sublistref}) {
+ my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
+ undef,$mtime)=split(/\&/,$line,12);
+ unless (($testdir&$dirptr) ||
+ ($file_name =~ /^\.\.?$/)) {
+ $currsubfile{$path}{$file_name} = [$size,$mtime];
+ }
+ }
+ }
+ }
}
}
foreach my $file (keys(%{$subdependencies{$path}})) {
- if ($currsubfile{$file}) {
+ if (exists($currsubfile{$path}{$file})) {
my $item = $path.'/'.$file;
unless ($mapping{$item} eq $item) {
$pathchanges{$item} = 1;
@@ -8983,9 +9950,27 @@ sub ask_for_embedded_content {
$newfiles{$path.'/'.$file} = 1;
}
}
+ if ($actionurl eq '/adm/dependencies') {
+ foreach my $path (keys(%currsubfile)) {
+ if (ref($currsubfile{$path}) eq 'HASH') {
+ foreach my $file (keys(%{$currsubfile{$path}})) {
+ unless ($subdependencies{$path}{$file}) {
+ next if (($rem ne '') &&
+ (($env{"httpref.$rem"."$path/$file"} ne '') ||
+ (ref($navmap) &&
+ (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
+ (($file =~ /^(.*\.s?html?)\.bak$/i) &&
+ ($navmap->getResourceByUrl($rem."$path/$1")))))));
+ $unused{$path.'/'.$file} = 1;
+ }
+ }
+ }
+ }
+ }
}
my %currfile;
- if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ if (($actionurl eq '/adm/portfolio') ||
+ ($actionurl eq '/adm/coursegrp_portfolio')) {
my ($dirlistref,$listerror) =
&Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
if (ref($dirlistref) eq 'ARRAY') {
@@ -8999,9 +9984,30 @@ sub ask_for_embedded_content {
my @dir_list = grep(!/^\./,readdir($dir));
map {$currfile{$_} = 1;} @dir_list;
}
+ } elsif (($actionurl eq '/adm/dependencies') ||
+ (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
+ ($args->{'context'} eq 'paste')) ||
+ ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
+ if ($env{'request.course.id'} ne '') {
+ my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
+ if ($dir ne '') {
+ my ($dirlistref,$listerror) =
+ &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
+ if (ref($dirlistref) eq 'ARRAY') {
+ foreach my $line (@{$dirlistref}) {
+ my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
+ $size,undef,$mtime)=split(/\&/,$line,12);
+ unless (($testdir&$dirptr) ||
+ ($file_name =~ /^\.\.?$/)) {
+ $currfile{$file_name} = [$size,$mtime];
+ }
+ }
+ }
+ }
+ }
}
foreach my $file (keys(%dependencies)) {
- if ($currfile{$file}) {
+ if (exists($currfile{$file})) {
unless ($mapping{$file} eq $file) {
$pathchanges{$file} = 1;
}
@@ -9011,41 +10017,137 @@ sub ask_for_embedded_content {
$newfiles{$file} = 1;
}
}
+ foreach my $file (keys(%currfile)) {
+ unless (($file eq $filename) ||
+ ($file eq $filename.'.bak') ||
+ ($dependencies{$file})) {
+ if ($actionurl eq '/adm/dependencies') {
+ unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
+ next if (($rem ne '') &&
+ (($env{"httpref.$rem".$file} ne '') ||
+ (ref($navmap) &&
+ (($navmap->getResourceByUrl($rem.$file) ne '') ||
+ (($file =~ /^(.*\.s?html?)\.bak$/i) &&
+ ($navmap->getResourceByUrl($rem.$1)))))));
+ }
+ }
+ $unused{$file} = 1;
+ }
+ }
+ if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
+ ($args->{'context'} eq 'paste')) {
+ $counter = scalar(keys(%existing));
+ $numpathchg = scalar(keys(%pathchanges));
+ return ($output,$counter,$numpathchg,\%existing);
+ } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
+ (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
+ $counter = scalar(keys(%existing));
+ $numpathchg = scalar(keys(%pathchanges));
+ return ($output,$counter,$numpathchg,\%existing,\%mapping);
+ }
foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
+ if ($actionurl eq '/adm/dependencies') {
+ next if ($embed_file =~ m{^\w+://});
+ }
$upload_output .= &start_data_table_row().
- '
' x2)."\n";
+ }
+ if ($is_dir) {
+ $output .= '
'."\n".
+ ''."\n";
+ } else {
+ $output .= ''."\n";
+ }
+ $output .= ' '.$name.'
';
+ last;
+ }
+ }
+ return $output;
+}
+
+sub captcha_settings {
+ my %captcha_params = (
+ output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
+ www_output_dir => "/captchaspool",
+ db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
+ numchars => '5',
+ );
+ return %captcha_params;
+}
+
+sub check_captcha {
+ my ($captcha_chk,$captcha_error);
+ my $code = $env{'form.code'};
+ my $md5sum = $env{'form.crypt'};
+ my %captcha_params = &captcha_settings();
+ my $captcha = Authen::Captcha->new(
+ output_folder => $captcha_params{'output_dir'},
+ data_folder => $captcha_params{'db_dir'},
+ );
+ $captcha_chk = $captcha->check_code($code,$md5sum);
+ my %captcha_hash = (
+ 0 => 'Code not checked (file error)',
+ -1 => 'Failed: code expired',
+ -2 => 'Failed: invalid code (not in database)',
+ -3 => 'Failed: invalid code (code does not match crypt)',
+ );
+ if ($captcha_chk != 1) {
+ $captcha_error = $captcha_hash{$captcha_chk}
+ }
+ return ($captcha_chk,$captcha_error);
+}
+
+sub create_recaptcha {
+ my ($pubkey) = @_;
+ my $captcha = Captcha::reCAPTCHA->new;
+ return $captcha->get_options_setter({theme => 'white'})."\n".
+ $captcha->get_html($pubkey).
+ &mt('If either word is hard to read, [_1] will replace them.',
+ '
').
+ '