";
+ return <<"END";
+$nicescroll_js
+
+
|
'.$msg.'
'. &Apache::loncommon::end_page(); if (ref($r)) { $r->print($page); @@ -7116,7 +8223,7 @@ sub get_users_function { $function='admin'; } if (($env{'request.role'}=~/^(au|ca|aa)/) || - ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { + ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) { $function='author'; } return $function; @@ -7174,8 +8281,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'; @@ -7253,7 +8359,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(); @@ -7280,6 +8398,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; } @@ -7427,7 +8548,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'})) { @@ -7437,6 +8558,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; @@ -7472,7 +8597,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; } @@ -7560,11 +8685,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. @@ -7578,7 +8708,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 @@ -7586,7 +8716,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'}; @@ -7601,27 +8731,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) { @@ -7641,14 +8801,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. @@ -7662,33 +8826,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}; @@ -7702,16 +8868,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); @@ -7720,6 +8895,63 @@ 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).
+ '
'.&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})) {
@@ -8231,7 +9466,8 @@ sub get_standard_codeitems {
=item * sorted_slots()
-Sorts an array of slot names in order of slot start time (earliest first).
+Sorts an array of slot names in order of an optional sort key,
+default sort is by slot start time (earliest first).
Inputs:
@@ -8241,15 +9477,16 @@ slotsarr - Reference to array of unsort
slots - Reference to hash of hash, where outer hash keys are slot names.
+sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
+
=back
Returns:
=over 4
-sorted - An array of slot names sorted by the start time of the slot.
-
-=back
+sorted - An array of slot names sorted by a specified sort key
+ (default sort key is start time of the slot).
=back
@@ -8257,13 +9494,16 @@ sorted - An array of slot names sorted
sub sorted_slots {
- my ($slotsarr,$slots) = @_;
+ my ($slotsarr,$slots,$sortkey) = @_;
+ if ($sortkey eq '') {
+ $sortkey = 'starttime';
+ }
my @sorted;
if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
@sorted =
sort {
if (ref($slots->{$a}) && ref($slots->{$b})) {
- return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
+ return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
}
if (ref($slots->{$a})) { return -1;}
if (ref($slots->{$b})) { return 1;}
@@ -8273,9 +9513,136 @@ sub sorted_slots {
return @sorted;
}
+=pod
+
+=item * get_future_slots()
+
+Inputs:
+
+=over 4
+
+cnum - course number
+
+cdom - course domain
+
+now - current UNIX time
+
+symb - optional symb
+
+=back
+
+Returns:
+
+=over 4
+
+sorted_reservable - ref to array of student_schedulable slots currently
+ reservable, ordered by end date of reservation period.
+
+reservable_now - ref to hash of student_schedulable slots currently
+ reservable.
+
+ Keys in inner hash are:
+ (a) symb: either blank or symb to which slot use is restricted.
+ (b) endreserve: end date of reservation period.
+
+sorted_future - ref to array of student_schedulable slots reservable in
+ the future, ordered by start date of reservation period.
+
+future_reservable - ref to hash of student_schedulable slots reservable
+ in the future.
+
+ Keys in inner hash are:
+ (a) symb: either blank or symb to which slot use is restricted.
+ (b) startreserve: start date of reservation period.
+
+=back
+
+=cut
+
+sub get_future_slots {
+ my ($cnum,$cdom,$now,$symb) = @_;
+ my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
+ my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
+ foreach my $slot (keys(%slots)) {
+ next unless($slots{$slot}->{'type'} eq 'schedulable_student');
+ if ($symb) {
+ next if (($slots{$slot}->{'symb'} ne '') &&
+ ($slots{$slot}->{'symb'} ne $symb));
+ }
+ if (($slots{$slot}->{'starttime'} > $now) &&
+ ($slots{$slot}->{'endtime'} > $now)) {
+ if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
+ my $userallowed = 0;
+ if ($slots{$slot}->{'allowedsections'}) {
+ my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
+ if (!defined($env{'request.role.sec'})
+ && grep(/^No section assigned$/,@allowed_sec)) {
+ $userallowed=1;
+ } else {
+ if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
+ $userallowed=1;
+ }
+ }
+ unless ($userallowed) {
+ if (defined($env{'request.course.groups'})) {
+ my @groups = split(/:/,$env{'request.course.groups'});
+ foreach my $group (@groups) {
+ if (grep(/^\Q$group\E$/,@allowed_sec)) {
+ $userallowed=1;
+ last;
+ }
+ }
+ }
+ }
+ }
+ if ($slots{$slot}->{'allowedusers'}) {
+ my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
+ my $user = $env{'user.name'}.':'.$env{'user.domain'};
+ if (grep(/^\Q$user\E$/,@allowed_users)) {
+ $userallowed = 1;
+ }
+ }
+ next unless($userallowed);
+ }
+ my $startreserve = $slots{$slot}->{'startreserve'};
+ my $endreserve = $slots{$slot}->{'endreserve'};
+ my $symb = $slots{$slot}->{'symb'};
+ if (($startreserve < $now) &&
+ (!$endreserve || $endreserve > $now)) {
+ my $lastres = $endreserve;
+ if (!$lastres) {
+ $lastres = $slots{$slot}->{'starttime'};
+ }
+ $reservable_now{$slot} = {
+ symb => $symb,
+ endreserve => $lastres
+ };
+ } elsif (($startreserve > $now) &&
+ (!$endreserve || $endreserve > $startreserve)) {
+ $future_reservable{$slot} = {
+ symb => $symb,
+ startreserve => $startreserve
+ };
+ }
+ }
+ }
+ my @unsorted_reservable = keys(%reservable_now);
+ if (@unsorted_reservable > 0) {
+ @sorted_reservable =
+ &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
+ }
+ my @unsorted_future = keys(%future_reservable);
+ if (@unsorted_future > 0) {
+ @sorted_future =
+ &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
+ }
+ return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
+}
=pod
+=back
+
=head1 HTTP Helpers
=over 4
@@ -8414,21 +9781,36 @@ 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,$navmap);
+ my $heading = &mt('Upload embedded files');
+ my $buttontext = &mt('Upload');
+
+ 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'};
@@ -8440,31 +9822,74 @@ sub ask_for_embedded_content {
$getpropath = 1;
} elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
($actionurl eq '/adm/imsimport')) {
- ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$});
- $url = '/home/'.$uname.'/public_html/';
+ my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
+ $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
$toplevel = $url;
if ($rest ne '') {
$url .= $rest;
}
} 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)");
+ }
}
- }
- my $now = time();
- foreach my $embed_file (keys(%{$allfiles})) {
- my $absolutepath;
+ } 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 ($absolutepath,$cleaned_file);
if ($embed_file =~ m{^\w+://}) {
- $newfiles{$embed_file} = 1;
- $mapping{$embed_file} = $embed_file;
+ $cleaned_file = $embed_file;
+ $newfiles{$cleaned_file} = 1;
+ $mapping{$cleaned_file} = $embed_file;
} else {
+ $cleaned_file = &clean_path($embed_file);
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 '') {
@@ -8481,29 +9906,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')) {
- my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
- foreach my $line (@subdir_list) {
- my ($file_name,$rest) = split(/\&/,$line,2);
- $currsubfile{$file_name} = 1;
+ $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{$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;
@@ -8514,22 +9970,64 @@ 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')) {
- my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
- foreach my $line (@dir_list) {
- my ($file_name,$rest) = split(/\&/,$line,2);
- $currfile{$file_name} = 1;
+ 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') {
+ foreach my $line (@{$dirlistref}) {
+ my ($file_name,$rest) = split(/\&/,$line,2);
+ $currfile{$file_name} = 1;
+ }
}
} elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
if (opendir(my $dir,$url)) {
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;
}
@@ -8539,41 +10037,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().
- '
'.&mt('changed from: [_1]',$mapping{$embed_file}).''; + $upload_output .= '
'. + &mt('changed from: [_1]',$mapping{$embed_file}).''; } - $upload_output .= '
'.&mt('or').'
'; - } + } + } + return ($output,$counter,$numpathchg); +} + +=pod + +=item * clean_path($name) + +Performs clean-up of directories, subdirectories and filename in an +embedded object, referenced in an HTML file which is being uploaded +to a course or portfolio, where +"Upload embedded images/multimedia files if HTML file" checkbox was +checked. + +Clean-up is similar to replacements in lonnet::clean_filename() +except each / between sub-directory and next level is preserved. + +=cut + +sub clean_path { + my ($embed_file) = @_; + $embed_file =~s{^/+}{}; + my @contents; + if ($embed_file =~ m{/}) { + @contents = split(/\//,$embed_file); + } else { + @contents = ($embed_file); + } + my $lastidx = scalar(@contents)-1; + for (my $i=0; $i<=$lastidx; $i++) { + $contents[$i]=~s{\\}{/}g; + $contents[$i]=~s/\s+/\_/g; + $contents[$i]=~s{[^/\w\.\-]}{}g; + if ($i == $lastidx) { + $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g; + } + } + if ($lastidx > 0) { + return join('/',@contents); + } else { + return $contents[0]; } - return ($output,$num,$numpathchg); } sub embedded_file_element { - my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_; + my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_; return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') && (ref($codebase) eq 'HASH')); my $output; - if ($context eq 'upload_embedded') { + if (($context eq 'upload_embedded') && ($type ne 'delete')) { $output = ''."\n"; } $output .= ' 0) { + $showmtime = &Apache::lonlocal::locallocaltime($mtime); + } + } + return ($showsize,$showmtime); +} + +sub ask_embedded_js { + return <<"END"; + + +END +} + sub upload_embedded { my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota, $current_disk_usage,$hiddenstate,$actionurl) = @_; @@ -8745,29 +10446,31 @@ sub upload_embedded { # Check if extension is valid if (($fname =~ /\.(\w+)$/) && (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { - $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).''; + $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1) + .' '.&mt('Rename the file with a different extension and re-upload.').'
'; next; } elsif (($fname =~ /\.(\w+)$/) && (!defined(&Apache::loncommon::fileembstyle($1)))) { $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'
'; next; } elsif ($fname=~/\.(\d+)\.(\w+)$/) { - $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'
'; + $output .= &mt('Filename not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'
'; next; } - $env{'form.embedded_item_'.$i.'.filename'}=$fname; + my $subdir = $path; + $subdir =~ s{/+$}{}; if ($context eq 'portfolio') { my $result; if ($state eq 'existingfile') { $result= &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile', - $dirpath.$env{'form.currentpath'}.$path); + $dirpath.$env{'form.currentpath'}.$subdir); } else { $result= &Apache::lonnet::userfileupload('embedded_item_'.$i,'', $dirpath. - $env{'form.currentpath'}.$path); + $env{'form.currentpath'}.$subdir); if ($result !~ m|^/uploaded/|) { $output .= '' .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].' @@ -8779,10 +10482,11 @@ sub upload_embedded { $path.$fname.'').'
'; } } - } elsif ($context eq 'coursedoc') { + } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) { + my $extendedsubdir = $dirpath.'/'.$subdir; + $extendedsubdir =~ s{/+$}{}; my $result = - &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc', - $dirpath.'/'.$path); + &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir); if ($result !~ m|^/uploaded/|) { $output .= '' .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].' @@ -8792,6 +10496,9 @@ sub upload_embedded { } else { $output .= &mt('Uploaded [_1]',''. $path.$fname.'').'
'; + if ($context eq 'syllabus') { + &Apache::lonnet::make_public_indefinitely($result); + } } } else { # Save the file @@ -8799,12 +10506,12 @@ sub upload_embedded { my $fullpath = $dir_root.$dirpath.'/'.$path; my $dest = $fullpath.$fname; my $url = $url_root.$dirpath.'/'.$path.$fname; - my @parts=split(/\//,$fullpath); + my @parts=split(/\//,"$dirpath/$path"); my $count; my $filepath = $dir_root; - for ($count=4;$count<=$#parts;$count++) { - $filepath .= "/$parts[$count]"; - if ((-e $filepath)!=1) { + foreach my $subdir (@parts) { + $filepath .= "/$subdir"; + if (!-e $filepath) { mkdir($filepath,0770); } } @@ -8812,13 +10519,15 @@ sub upload_embedded { if (!open($fh,'>'.$dest)) { &Apache::lonnet::logthis('Failed to create '.$dest); $output .= ''. - &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). + &mt('An error occurred while trying to upload [_1] for embedded element [_2].', + $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). '
'; } else { if (!print $fh $env{'form.embedded_item_'.$i}) { &Apache::lonnet::logthis('Failed to write to '.$dest); $output .= ''. - &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). + &mt('An error occurred while writing the file [_1] for embedded element [_2].', + $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). '
'; } else { $output .= &mt('Uploaded [_1]',''. @@ -8840,15 +10549,17 @@ sub upload_embedded { } $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange); $returnflag = 'ok'; - if (keys(%pathchange) > 0) { + my $numpathchgs = scalar(keys(%pathchange)); + if ($numpathchgs > 0) { if ($context eq 'portfolio') { $output .= '
'.&mt('or').'
'; } elsif ($context eq 'testbank') { - $output .= ''.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','','').'
'; + $output .= ''.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).', + '','').'
'; $returnflag = 'modify_orightml'; } } - return ($output.$footer,$returnflag); + return ($output.$footer,$returnflag,$numpathchgs); } sub modify_html_form { @@ -8883,7 +10594,7 @@ sub modify_html_form { ''. &end_data_table_row(); - } + } } } else { $modifyform = $pathchgtable; @@ -8894,6 +10605,9 @@ sub modify_html_form { } } if ($modifyform) { + if ($actionurl eq '/adm/dependencies') { + $hiddenstate .= ''; + } return ''.&mt('Changes in content of HTML file required').'
'."\n". ''.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').'
- '."\n".
'
- '.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').' '."\n". @@ -8916,30 +10630,63 @@ sub modify_html_form { } sub modify_html_refs { - my ($context,$dirpath,$uname,$udom,$dir_root) = @_; + my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_; my $container; if ($context eq 'portfolio') { $container = $env{'form.container'}; } elsif ($context eq 'coursedoc') { $container = $env{'form.primaryurl'}; + } elsif ($context eq 'manage_dependencies') { + (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'}); + $container = "/$container"; + } elsif ($context eq 'syllabus') { + $container = $url; } else { - $container = $env{'form.filename'}; - $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2}; + $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'}; } my (%allfiles,%codebase,$output,$content); my @changes = &get_env_multiple('form.namechange'); - return unless (@changes > 0); - if (($context eq 'portfolio') || ($context eq 'coursedoc')) { - return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}); + unless ((@changes > 0) || ($context eq 'syllabus')) { + if (wantarray) { + return ('',0,0); + } else { + return; + } + } + if (($context eq 'portfolio') || ($context eq 'coursedoc') || + ($context eq 'manage_dependencies') || ($context eq 'syllabus')) { + unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) { + if (wantarray) { + return ('',0,0); + } else { + return; + } + } $content = &Apache::lonnet::getfile($container); - return if ($content eq '-1'); + if ($content eq '-1') { + if (wantarray) { + return ('',0,0); + } else { + return; + } + } } else { - return unless ($container =~ /^\Q$dir_root\E/); + unless ($container =~ /^\Q$dir_root\E/) { + if (wantarray) { + return ('',0,0); + } else { + return; + } + } if (open(my $fh,"<$container")) { $content = join('', <$fh>); close($fh); } else { - return; + if (wantarray) { + return ('',0,0); + } else { + return; + } } } my ($count,$codebasecount) = (0,0); @@ -8963,6 +10710,8 @@ sub modify_html_refs { if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) { my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi); $count += $numchg; + $allfiles{$newname} = $allfiles{$ref}; + delete($allfiles{$ref}); } if ($env{'form.embedded_codebase_'.$i} ne '') { $codebase = &unescape($env{'form.embedded_codebase_'.$i}); @@ -8971,21 +10720,28 @@ sub modify_html_refs { } } } + my $skiprewrites; if ($count || $codebasecount) { my $saveresult; - if ($context eq 'portfolio' || $context eq 'coursedoc') { + if (($context eq 'portfolio') || ($context eq 'coursedoc') || + ($context eq 'manage_dependencies') || ($context eq 'syllabus')) { my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); if ($url eq $container) { my ($fname) = ($container =~ m{/([^/]+)$}); $output = '
'.&mt('Updated [quant,_1,reference] in [_2].', $count,''. - $fname.'').'
'; + $fname.''. &mt('Error: update failed for: [_1].', ''. $container.'').'
'; } + if ($context eq 'syllabus') { + unless ($saveresult eq 'ok') { + $skiprewrites = 1; + } + } } else { if (open(my $fh,">$container")) { print $fh $content; @@ -9001,12 +10757,57 @@ sub modify_html_refs { } } } + if (($context eq 'syllabus') && (!$skiprewrites)) { + my ($actionurl,$state); + $actionurl = "/public/$udom/$uname/syllabus"; + my ($ignore,$num,$numpathchanges,$existing,$mapping) = + &ask_for_embedded_content($actionurl,$state,\%allfiles, + \%codebase, + {'context' => 'rewrites', + 'ignore_remote_references' => 1,}); + if (ref($mapping) eq 'HASH') { + my $rewrites = 0; + foreach my $key (keys(%{$mapping})) { + next if ($key =~ m{^https?://}); + my $ref = $mapping->{$key}; + my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key"; + my $attrib; + if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') { + $attrib = join('|',@{$allfiles{$mapping->{$key}}}); + } + if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) { + my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi); + $rewrites += $numchg; + } + } + if ($rewrites) { + my $saveresult; + my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); + if ($url eq $container) { + my ($fname) = ($container =~ m{/([^/]+)$}); + $output .= ''.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].', + $count,''. + $fname.'').'
'; + } else { + $output .= ''. + &mt('Error: could not update links in [_1].', + ''. + $container.'').'
'; + + } + } + } + } } else { &logthis('Failed to parse '.$container. ' to modify references: '.$parse_result); } } - return $output; + if (wantarray) { + return ($output,$count,$codebasecount); + } else { + return $output; + } } sub check_for_existing { @@ -9040,8 +10841,8 @@ sub check_for_upload { } $filesize = $filesize/1000; #express in k (1024?) my $getpropath = 1; - my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname, - $getpropath); + my ($dirlistref,$listerror) = + &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath); my $found_file = 0; my $locked_file = 0; my @lockers; @@ -9049,48 +10850,50 @@ sub check_for_upload { if ($env{'request.course.id'}) { $navmap = Apache::lonnavmaps::navmap->new(); } - foreach my $line (@dir_list) { - my ($file_name,$rest)=split(/\&/,$line,2); - if ($file_name eq $fname){ - $file_name = $path.$file_name; - if ($group ne '') { - $file_name = $group.$file_name; - } - $found_file = 1; - if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') { - foreach my $lock (@lockers) { - if (ref($lock) eq 'ARRAY') { - my ($symb,$crsid) = @{$lock}; - if ($crsid eq $env{'request.course.id'}) { - if (ref($navmap)) { - my $res = $navmap->getBySymb($symb); - foreach my $part (@{$res->parts()}) { - my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part); - unless (($slot_status == $res->RESERVED) || - ($slot_status == $res->RESERVED_LOCATION)) { - $locked_file = 1; + if (ref($dirlistref) eq 'ARRAY') { + foreach my $line (@{$dirlistref}) { + my ($file_name,$rest)=split(/\&/,$line,2); + if ($file_name eq $fname){ + $file_name = $path.$file_name; + if ($group ne '') { + $file_name = $group.$file_name; + } + $found_file = 1; + if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') { + foreach my $lock (@lockers) { + if (ref($lock) eq 'ARRAY') { + my ($symb,$crsid) = @{$lock}; + if ($crsid eq $env{'request.course.id'}) { + if (ref($navmap)) { + my $res = $navmap->getBySymb($symb); + foreach my $part (@{$res->parts()}) { + my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part); + unless (($slot_status == $res->RESERVED) || + ($slot_status == $res->RESERVED_LOCATION)) { + $locked_file = 1; + } } + } else { + $locked_file = 1; } } else { $locked_file = 1; } - } else { - $locked_file = 1; } - } - } - } else { - my @info = split(/\&/,$rest); - my $currsize = $info[6]/1000; - if ($currsize < $filesize) { - my $extra = $filesize - $currsize; - if (($current_disk_usage + $extra) > $disk_quota) { - my $msg = ''. - &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.', - ''.$fname.'',$filesize,$currsize).''. - ''.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', - $disk_quota,$current_disk_usage); - return ('will_exceed_quota',$msg); + } + } else { + my @info = split(/\&/,$rest); + my $currsize = $info[6]/1000; + if ($currsize < $filesize) { + my $extra = $filesize - $currsize; + if (($current_disk_usage + $extra) > $disk_quota) { + my $msg = ''. + &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.', + ''.$fname.'',$filesize,$currsize).''. + '
'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', + $disk_quota,$current_disk_usage); + return ('will_exceed_quota',$msg); + } } } } @@ -9160,6 +10963,1172 @@ sub check_for_traversal { return $cleanpath; } +sub is_archive_file { + my ($mimetype) = @_; + if (($mimetype eq 'application/octet-stream') || + ($mimetype eq 'application/x-stuffit') || + ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) { + return 1; + } + return; +} + +sub decompress_form { + my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_; + my %lt = &Apache::lonlocal::texthash ( + this => 'This file is an archive file.', + camt => 'This file is a Camtasia archive file.', + itsc => 'Its contents are as follows:', + youm => 'You may wish to extract its contents.', + extr => 'Extract contents', + auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.', + proa => 'Process automatically?', + yes => 'Yes', + no => 'No', + fold => 'Title for folder containing movie', + movi => 'Title for page containing embedded movie', + ); + my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl); + my ($is_camtasia,$topdir,%toplevel,@paths); + my $info = &list_archive_contents($fileloc,\@paths); + if (@paths) { + foreach my $path (@paths) { + $path =~ s{^/}{}; + if ($path =~ m{^([^/]+)/$}) { + $topdir = $1; + } + if ($path =~ m{^([^/]+)/}) { + $toplevel{$1} = $path; + } else { + $toplevel{$path} = $path; + } + } + } + if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) { + my @camtasia = ("$topdir/","$topdir/index.html", + "$topdir/media/", + "$topdir/media/$topdir.mp4", + "$topdir/media/FirstFrame.png", + "$topdir/media/player.swf", + "$topdir/media/swfobject.js", + "$topdir/media/expressInstall.swf"); + my @diffs = &compare_arrays(\@paths,\@camtasia); + if (@diffs == 0) { + $is_camtasia = 1; + } + } + my $output; + if ($is_camtasia) { + $output = <<"ENDCAM"; + +
$lt{'camt'}
+ENDCAM + } else { + $output = ''.$lt{'this'}; + if ($info eq '') { + $output .= ' '.$lt{'youm'}.'
'."\n"; + } else { + $output .= ' '.$lt{'itsc'}.''."\n". + ''.$info.'
'.&mt('Filename should end with one of: [_1].', + '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz'); + } else { + my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom); + if ($docuhome eq 'no_host') { + $error = &mt('Could not determine home server for course.'); + } else { + my @ids=&Apache::lonnet::current_machine_ids(); + my $currdir = "$dir_root/$destination"; + if (grep(/^\Q$docuhome\E$/,@ids)) { + $dir = &LONCAPA::propath($docudom,$docuname). + "$dir_root/$destination"; + } else { + $dir = $Apache::lonnet::perlvar{'lonDocRoot'}. + "$dir_root/$docudom/$docuname/$destination"; + unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') { + $error = &mt('Archive file not found.'); + } + } + my (@to_overwrite,@to_skip); + if ($env{'form.archive_overwrite_total'} > 0) { + my $total = $env{'form.archive_overwrite_total'}; + for (my $i=0; $i<$total; $i++) { + if ($env{'form.archive_overwrite_'.$i} == 1) { + push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i}); + } elsif ($env{'form.archive_overwrite_'.$i} == 0) { + push(@to_skip,$env{'form.archive_overwrite_name_'.$i}); + } + } + } + my $numskip = scalar(@to_skip); + if (($numskip > 0) && + ($numskip == $env{'form.archive_itemcount'})) { + $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.'); + } elsif ($dir eq '') { + $error = &mt('Directory containing archive file unavailable.'); + } elsif (!$error) { + my ($decompressed,$display); + if ($numskip > 0) { + my $tempdir = time.'_'.$$.int(rand(10000)); + mkdir("$dir/$tempdir",0755); + system("mv $dir/$file $dir/$tempdir/$file"); + ($decompressed,$display) = + &decompress_uploaded_file($file,"$dir/$tempdir"); + foreach my $item (@to_skip) { + if (($item ne '') && ($item !~ /\.\./)) { + if (-f "$dir/$tempdir/$item") { + unlink("$dir/$tempdir/$item"); + } elsif (-d "$dir/$tempdir/$item") { + system("rm -rf $dir/$tempdir/$item"); + } + } + } + system("mv $dir/$tempdir/* $dir"); + rmdir("$dir/$tempdir"); + } else { + ($decompressed,$display) = + &decompress_uploaded_file($file,$dir); + } + if ($decompressed eq 'ok') { + $output = '
'. + &mt('Files extracted successfully from archive.'). + '
'."\n"; + my ($warning,$result,@contents); + my ($newdirlistref,$newlisterror) = + &Apache::lonnet::dirlist($currdir,$docudom, + $docuname,1); + my (%is_dir,%changes,@newitems); + my $dirptr = 16384; + if (ref($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); + unless (($item =~ /^\.+$/) || ($item eq $file) || + ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) { + push(@newitems,$item); + if ($dirptr&$testdir) { + $is_dir{$item} = 1; + } + $changes{$item} = 1; + } + } + } + if (keys(%changes) > 0) { + foreach my $item (sort(@newitems)) { + if ($changes{$item}) { + push(@contents,$item); + } + } + } + if (@contents > 0) { + my $wantform; + unless ($env{'form.autoextract_camtasia'}) { + $wantform = 1; + } + my (%children,%parent,%dirorder,%titles); + my ($count,$datatable) = &get_extracted($docudom,$docuname, + $currdir,\%is_dir, + \%children,\%parent, + \@contents,\%dirorder, + \%titles,$wantform); + if ($datatable ne '') { + $output .= &archive_options_form('decompressed',$datatable, + $count,$hiddenelem); + my $startcount = 6; + $output .= &archive_javascript($startcount,$count, + \%titles,\%children); + } + if ($env{'form.autoextract_camtasia'}) { + my %displayed; + my $total = 1; + $env{'form.archive_directory'} = []; + foreach my $i (sort { $a <=> $b } keys(%dirorder)) { + my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}}); + $path =~ s{/$}{}; + my $item; + if ($path ne '') { + $item = "$path/$titles{$i}"; + } else { + $item = $titles{$i}; + } + $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item"; + if ($item eq $contents[0]) { + push(@{$env{'form.archive_directory'}},$i); + $env{'form.archive_'.$i} = 'display'; + $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'}; + $displayed{'folder'} = $i; + } elsif ($item eq "$contents[0]/index.html") { + $env{'form.archive_'.$i} = 'display'; + $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'}; + $displayed{'web'} = $i; + } else { + if ($item eq "$contents[0]/media") { + push(@{$env{'form.archive_directory'}},$i); + } + $env{'form.archive_'.$i} = 'dependency'; + } + $total ++; + } + for (my $i=1; $i<$total; $i++) { + next if ($i == $displayed{'web'}); + next if ($i == $displayed{'folder'}); + $env{'form.archive_dependent_on_'.$i} = $displayed{'web'}; + } + $env{'form.phase'} = 'decompress_cleanup'; + $env{'form.archivedelete'} = 1; + $env{'form.archive_count'} = $total-1; + $output .= + &process_extracted_files('coursedocs',$docudom, + $docuname,$destination, + $dir_root,$hiddenelem); + } + } else { + $warning = &mt('No new items extracted from archive file.'); + } + } else { + $output = $display; + $error = &mt('An error occurred during extraction from the archive file.'); + } + } + } + } + if ($error) { + $output .= ''.&mt('Not extracted.').'
'.
+ $error.'
'.$warning.'
'."\n"; + } + return $output; +} + +sub get_extracted { + my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder, + $titles,$wantform) = @_; + my $count = 0; + my $depth = 0; + my $datatable; + my @hierarchy; + return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') && + (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') && + (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH')); + foreach my $item (@{$contents}) { + $count ++; + @{$dirorder->{$count}} = @hierarchy; + $titles->{$count} = $item; + &archive_hierarchy($depth,$count,$parent,$children); + if ($wantform) { + $datatable .= &archive_row($is_dir->{$item},$item, + $currdir,$depth,$count); + } + if ($is_dir->{$item}) { + $depth ++; + push(@hierarchy,$count); + $parent->{$depth} = $count; + $datatable .= + &recurse_extracted_archive("$currdir/$item",$docudom,$docuname, + \$depth,\$count,\@hierarchy,$dirorder, + $children,$parent,$titles,$wantform); + $depth --; + pop(@hierarchy); + } + } + return ($count,$datatable); +} + +sub recurse_extracted_archive { + my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder, + $children,$parent,$titles,$wantform) = @_; + my $result=''; + unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') && + (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') && + (ref($dirorder) eq 'HASH')) { + return $result; + } + my $dirptr = 16384; + my ($newdirlistref,$newlisterror) = + &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1); + if (ref($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); + unless ($item =~ /^\.+$/) { + $$count ++; + @{$dirorder->{$$count}} = @{$hierarchy}; + $titles->{$$count} = $item; + &archive_hierarchy($$depth,$$count,$parent,$children); + + my $is_dir; + if ($dirptr&$testdir) { + $is_dir = 1; + } + if ($wantform) { + $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count); + } + if ($is_dir) { + $$depth ++; + push(@{$hierarchy},$$count); + $parent->{$$depth} = $$count; + $result .= + &recurse_extracted_archive("$currdir/$item",$docudom, + $docuname,$depth,$count, + $hierarchy,$dirorder,$children, + $parent,$titles,$wantform); + $$depth --; + pop(@{$hierarchy}); + } + } + } + } + return $result; +} + +sub archive_hierarchy { + my ($depth,$count,$parent,$children) =@_; + if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) { + if (exists($parent->{$depth})) { + $children->{$parent->{$depth}} .= $count.':'; + } + } + return; +} + +sub archive_row { + my ($is_dir,$item,$currdir,$depth,$count) = @_; + my ($name) = ($item =~ m{([^/]+)$}); + my %choices = &Apache::lonlocal::texthash ( + 'display' => 'Add as file', + 'dependency' => 'Include as dependency', + 'discard' => 'Discard', + ); + if ($is_dir) { + $choices{'display'} = &mt('Add as folder'); + } + my $output = &start_data_table_row().'
' x2)."\n";
+ }
+ if ($is_dir) {
+ $output .= '
'."\n".
+ ''."\n";
+ } else {
+ $output .= ''."\n";
+ }
+ $output .= ' '.$name.''; + } + } + for (my $i=1; $i<=$numitems; $i++) { + next unless ($env{'form.archive_'.$i} eq 'dependency'); + my $path = $env{'form.archive_content_'.$i}; + if ($path =~ /^\Q$pathtocheck\E/) { + my ($title) = ($path =~ m{/([^/]+)$}); + $referrer{$i} = $env{'form.archive_dependent_on_'.$i}; + if ($env{'form.archive_'.$referrer{$i}} eq 'display') { + if (ref($dirorder{$i}) eq 'ARRAY') { + my ($itemidx,$fullpath,$relpath); + if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') { + my $container = $dirorder{$referrer{$i}}->[-1]; + for (my $j=0; $j<@{$dirorder{$i}}; $j++) { + if ($dirorder{$i}->[$j] eq $container) { + $itemidx = $j; + } + } + } + if ($itemidx eq '') { + $itemidx = 0; + } + if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) { + if ($mapinner{$referrer{$i}}) { + $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}"; + for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) { + if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) { + unless (defined($newseqid{$dirorder{$i}->[$j]})) { + $fullpath .= '/'.$titles{$dirorder{$i}->[$j]}; + $relpath .= '/'.$titles{$dirorder{$i}->[$j]}; + if (!-e $fullpath) { + mkdir($fullpath,0755); + } + } + } else { + last; + } + } + } + } elsif ($newdest{$referrer{$i}}) { + $fullpath = $newdest{$referrer{$i}}; + for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) { + if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') { + $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]}; + last; + } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) { + unless (defined($newseqid{$dirorder{$i}->[$j]})) { + $fullpath .= '/'.$titles{$dirorder{$i}->[$j]}; + $relpath .= '/'.$titles{$dirorder{$i}->[$j]}; + if (!-e $fullpath) { + mkdir($fullpath,0755); + } + } + } else { + last; + } + } + } + if ($fullpath ne '') { + if (-e "$prefix$path") { + system("mv $prefix$path $fullpath/$title"); + } + if (-e "$fullpath/$title") { + my $showpath; + if ($relpath ne '') { + $showpath = "$relpath/$title"; + } else { + $showpath = "/$title"; + } + $result .= '
'; + } + } else { + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; + } + } + if (keys(%todelete)) { + foreach my $key (keys(%todelete)) { + unlink($key); + } + } + if (keys(%todeletedir)) { + foreach my $key (keys(%todeletedir)) { + rmdir($key); + } + } + foreach my $dir (sort(keys(%is_dir))) { + if (($pathtocheck ne '') && ($dir ne '')) { + &cleanup_empty_dirs($prefix."$pathtocheck/$dir"); + } + } + if ($result ne '') { + $output .= '
- '."\n".
+ $result."\n".
+ '
'. + &mt('Course home server failed to retrieve:').'
- '.
+ $replicationfail.
+ '
'.&mt('Not extracted.').'
'.
+ $error.'
'.$warning.'
'."\n"; + } + return $output; +} + +sub cleanup_empty_dirs { + my ($path) = @_; + if (($path ne '') && (-d $path)) { + if (opendir(my $dirh,$path)) { + my @dircontents = grep(!/^\./,readdir($dirh)); + my $numitems = 0; + foreach my $item (@dircontents) { + if (-d "$path/$item") { + &cleanup_empty_dirs("$path/$item"); + if (-e "$path/$item") { + $numitems ++; + } + } else { + $numitems ++; + } + } + if ($numitems == 0) { + rmdir($path); + } + closedir($dirh); + } + } + return; +} + +=pod + +=item * &get_folder_hierarchy() + +Provides hierarchy of names of folders/sub-folders containing the current +item, + +Inputs: 3 + - $navmap - navmaps object + + - $map - url for map (either the trigger itself, or map containing + the resource, which is the trigger). + + - $showitem - 1 => show title for map itself; 0 => do not show. + +Outputs: 1 @pathitems - array of folder/subfolder names. + +=cut + +sub get_folder_hierarchy { + my ($navmap,$map,$showitem) = @_; + my @pathitems; + if (ref($navmap)) { + my $mapres = $navmap->getResourceByUrl($map); + if (ref($mapres)) { + my $pcslist = $mapres->map_hierarchy(); + if ($pcslist ne '') { + my @pcs = split(/,/,$pcslist); + foreach my $pc (@pcs) { + if ($pc == 1) { + push(@pathitems,&mt('Main Content')); + } else { + my $res = $navmap->getByMapPc($pc); + if (ref($res)) { + my $title = $res->compTitle(); + $title =~ s/\W+/_/g; + if ($title ne '') { + push(@pathitems,$title); + } + } + } + } + } + if ($showitem) { + if ($mapres->{ID} eq '0.0') { + push(@pathitems,&mt('Main Content')); + } else { + my $maptitle = $mapres->compTitle(); + $maptitle =~ s/\W+/_/g; + if ($maptitle ne '') { + push(@pathitems,$maptitle); + } + } + } + } + } + return @pathitems; +} + =pod =item * &get_turnedin_filepath() @@ -9213,6 +12182,9 @@ sub get_turnedin_filepath { my $title = $res->compTitle(); $title =~ s/\W+/_/g; if ($title ne '') { + if (($pc > 1) && (length($title) > 12)) { + $title = substr($title,0,12); + } push(@pathitems,$title); } } @@ -9221,6 +12193,9 @@ sub get_turnedin_filepath { my $maptitle = $mapres->compTitle(); $maptitle =~ s/\W+/_/g; if ($maptitle ne '') { + if (length($maptitle) > 12) { + $maptitle = substr($maptitle,0,12); + } push(@pathitems,$maptitle); } unless ($env{'request.state'} eq 'construct') { @@ -9261,6 +12236,9 @@ sub get_turnedin_filepath { $restitle = time; } } + if (length($restitle) > 12) { + $restitle = substr($restitle,0,12); + } push(@pathitems,$restitle); $path .= join('/',@pathitems); } @@ -10198,16 +13176,20 @@ sub restore_settings { =item * &build_recipient_list() -Build recipient lists for five types of e-mail: +Build recipient lists for following types of e-mail: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors -(d) Help requests, (e) Course requests needing approval, generated by -lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and -loncoursequeueadmin.pm respectively. +(d) Help requests, (e) Course requests needing approval, (f) loncapa +module change checking, student/employee ID conflict checks, as +generated by lonerrorhandler.pm, CHECKRPMS, loncron, +lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively. Inputs: defmail (scalar - email address of default recipient), -mailing type (scalar - errormail, packagesmail, or helpdeskmail), +mailing type (scalar: errormail, packagesmail, helpdeskmail, +requestsmail, updatesmail, or idconflictsmail). + defdom (domain for which to retrieve configuration settings), + origmail (scalar - email address of recipient from loncapa.conf, i.e., predates configuration by DC via domainprefs.pm @@ -10403,7 +13385,7 @@ sub extract_categories { =pod -=item *&recurse_categories() +=item * &recurse_categories() Recursively used to generate breadcrumb trails for course categories. @@ -10474,7 +13456,7 @@ sub recurse_categories { =pod -=item *&assign_categories_table() +=item * &assign_categories_table() Create a datatable for display of hierarchical categories in a domain, with checkboxes to allow a course to be categorized. @@ -10551,7 +13533,7 @@ sub assign_categories_table { =pod -=item *&assign_category_rows() +=item * &assign_category_rows() Create a datatable row for display of nested categories in a domain, with checkboxes to allow a course to be categorized,called recursively. @@ -10585,7 +13567,7 @@ sub assign_category_rows { if (ref($cats->[$depth]{$parent}) eq 'ARRAY') { my $numchildren = @{$cats->[$depth]{$parent}}; my $css_class = $itemcount%2?' class="LC_odd_row"':''; - $text .= '
';
+ 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 $use_ssl;
+ if ($ENV{'SERVER_PORT'} == 443) {
+ $use_ssl = 1;
+ }
+ my $captcha = Captcha::reCAPTCHA->new;
+ return $captcha->get_options_setter({theme => 'white'})."\n".
+ $captcha->get_html($pubkey,undef,$use_ssl).
+ &mt('If either word is hard to read, [_1] will replace them.',
+ '
').
+ '