--- loncom/interface/loncommon.pm 2011/12/19 18:00:23 1.1038
+++ loncom/interface/loncommon.pm 2013/01/03 20:10:02 1.1075.2.26
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1038 2011/12/19 18:00:23 www Exp $
+# $Id: loncommon.pm,v 1.1075.2.26 2013/01/03 20:10:02 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -67,9 +67,12 @@ use Apache::lonhtmlcommon();
use Apache::loncoursedata();
use Apache::lontexconvert();
use Apache::lonclonecourse();
+use Apache::lonuserutils();
use LONCAPA qw(:DEFAULT :match);
use DateTime::TimeZone;
use DateTime::Locale::Catalog;
+use Authen::Captcha;
+use Captcha::reCAPTCHA;
# ---------------------------------------------- Designs
use vars qw(%defaultdesign);
@@ -154,6 +157,8 @@ sub ssi_with_retries {
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
my %supported_language;
+my %latex_language; # For choosing hyphenation in
+my %latex_language_bykey; # for choosing hyphenation from metadata
my %cprtag;
my %scprtag;
my %fe; my %fd; my %fm;
@@ -186,11 +191,15 @@ BEGIN {
while (my $line = <$fh>) {
next if ($line=~/^\#/);
chomp($line);
- my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
+ my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
$language{$key}=$val.' - '.$enc;
if ($sup) {
$supported_language{$key}=$sup;
}
+ if ($latex) {
+ $latex_language_bykey{$key} = $latex;
+ $latex_language{$two} = $latex;
+ }
}
close($fh);
}
@@ -879,10 +888,14 @@ sub check_uncheck_jscript {
function checkAll(field) {
if (field.length > 0) {
for (i = 0; i < field.length; i++) {
- field[i].checked = true ;
+ if (!field[i].disabled) {
+ field[i].checked = true;
+ }
}
} else {
- field.checked = true
+ if (!field.disabled) {
+ field.checked = true;
+ }
}
}
@@ -1368,7 +1381,7 @@ function helpMenu(target) {
return;
}
function writeHelp(caller) {
- caller.document.writeln('$start_page $end_page')
+ caller.document.writeln('$start_page\\n\\n\\n$end_page')
caller.document.close()
caller.focus()
}
@@ -1742,6 +1755,7 @@ Inputs: $workbook
Returns: $format, a hash reference.
+
=cut
###############################################################
@@ -1974,19 +1988,112 @@ sub select_form {
# For display filters
sub display_filter {
+ my ($context) = @_;
if (!$env{'form.show'}) { $env{'form.show'}=10; }
if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
- return '
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
@@ -6876,7 +7435,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);
@@ -6893,7 +7452,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);
}
}
@@ -6922,6 +7482,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'})){
@@ -6929,6 +7493,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 .= '
+
+ENDPROGBAR
+ &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
+}
+
+sub LCprogressbarUpdate {
+ my ($r,$val,$text)=@_;
+ unless ($val) {
+ if ($LClastpercent) {
+ $val=$LClastpercent;
+ } else {
+ $val=0;
+ }
+ }
+ if ($val<0) { $val=0; }
+ if ($val>100) { $val=0; }
+ $LClastpercent=$val;
+ unless ($text) { $text=$val.'%'; }
+ $text=&js_ready($text);
+ &r_print($r,<
+//
+
+ENDUPDATE
+}
+
+sub LCprogressbarClose {
+ my ($r)=@_;
+ $LClastpercent=0;
+ &r_print($r,<
+//
+
+ENDCLOSE
+}
+
+sub r_print {
+ my ($r,$to_print)=@_;
+ if ($r) {
+ $r->print($to_print);
+ $r->rflush();
+ } else {
+ print($to_print);
+ }
}
sub html_encode {
@@ -7099,6 +7822,7 @@ sub html_encode {
return $result;
}
+
sub js_ready {
my ($result) = @_;
@@ -7137,16 +7861,21 @@ sub validate_page {
sub start_scrollbox {
- my ($outerwidth,$width,$height,$id)=@_;
+ my ($outerwidth,$width,$height,$id,$bgcolor)=@_;
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'";
}
- return "
";
+ if ($bgcolor ne '') {
+ $tdcol = "background-color: $bgcolor;";
+ }
+ return <<"END";
+
+END
}
sub end_scrollbox {
@@ -7157,7 +7886,7 @@ sub simple_error_page {
my ($r,$title,$msg) = @_;
my $page =
&Apache::loncommon::start_page($title).
- &mt($msg).
+ '
'.&mt($msg).'
'.
&Apache::loncommon::end_page();
if (ref($r)) {
$r->print($page);
@@ -7372,8 +8101,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';
@@ -8275,7 +9003,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})) {
@@ -8429,7 +9160,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:
@@ -8439,15 +9171,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
@@ -8455,13 +9188,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;}
@@ -8471,9 +9207,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
@@ -8612,13 +9475,24 @@ 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);
+ 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;
+ if ($env{'request.course.id'}) {
+ $navmap = Apache::lonnavmaps::navmap->new();
+ }
if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
my $current_path='/';
if ($env{'form.currentpath'}) {
@@ -8646,8 +9520,32 @@ 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 '') {
+ $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ if (ref($args) eq 'HASH') {
+ $url = $args->{'docs_url'};
+ $title = $args->{'docs_title'};
+ $toplevel = "/$url";
+ ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
+ ($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();
@@ -8686,25 +9584,46 @@ sub ask_for_embedded_content {
}
}
}
+ my $dirptr = 16384;
foreach my $path (keys(%subdependencies)) {
- my %currsubfile;
+ $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'))) {
+ if ($env{'request.course.id'} ne '') {
+ my ($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;
@@ -8715,6 +9634,23 @@ 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')) {
@@ -8731,9 +9667,29 @@ 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'))) {
+ 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;
}
@@ -8743,41 +9699,124 @@ 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') {
+ 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);
+ }
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().
- '