--- loncom/interface/loncommon.pm 2014/05/15 20:37:22 1.1075.2.72
+++ loncom/interface/loncommon.pm 2014/06/22 13:31:52 1.1075.2.79
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1075.2.72 2014/05/15 20:37:22 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.79 2014/06/22 13:31:52 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1293,7 +1293,7 @@ sub helpLatexCheatsheet {
$out .= ' '
.&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
.' '
- .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
+ .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
.'';
}
$out .= ''; # End cheatsheet
@@ -2341,6 +2341,8 @@ Outputs:
=item * $clientinfo
+=item * $clientosversion
+
=back
=back
@@ -2360,8 +2362,9 @@ sub decode_user_agent {
my $clientmathml='';
my $clientunicode='0';
my $clientmobile=0;
+ my $clientosversion='';
for (my $i=0;$i<=$#browsertype;$i++) {
- my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
+ my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
$clientbrowser=$bname;
$httpbrowser=~/$vreg/i;
@@ -2381,7 +2384,12 @@ sub decode_user_agent {
if ($httpbrowser=~/next/i) { $clientos='next'; }
if (($httpbrowser=~/mac/i) ||
($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
- if ($httpbrowser=~/win/i) { $clientos='win'; }
+ if ($httpbrowser=~/win/i) {
+ $clientos='win';
+ if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
+ $clientosversion = $1;
+ }
+ }
if ($httpbrowser=~/embed/i) { $clientos='pda'; }
if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
$clientmobile=lc($1);
@@ -2392,7 +2400,8 @@ sub decode_user_agent {
$clientinfo = 'chromeframe-'.$1;
}
return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
- $clientunicode,$clientos,$clientmobile,$clientinfo);
+ $clientunicode,$clientos,$clientmobile,$clientinfo,
+ $clientosversion);
}
###############################################################
@@ -4236,23 +4245,20 @@ sub findallcourses {
###############################################
sub blockcheck {
- my ($setters,$activity,$uname,$udom,$url) = @_;
+ my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
- if (!defined($udom)) {
+ if (defined($udom) && defined($uname)) {
+ # If uname and udom are for a course, check for blocks in the course.
+ if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
+ my ($startblock,$endblock,$triggerblock) =
+ &get_blocks($setters,$activity,$udom,$uname,$url);
+ return ($startblock,$endblock,$triggerblock);
+ }
+ } else {
$udom = $env{'user.domain'};
- }
- if (!defined($uname)) {
$uname = $env{'user.name'};
}
- # If uname and udom are for a course, check for blocks in the course.
-
- if (&Apache::lonnet::is_course($udom,$uname)) {
- my ($startblock,$endblock,$triggerblock) =
- &get_blocks($setters,$activity,$udom,$uname,$url);
- return ($startblock,$endblock,$triggerblock);
- }
-
my $startblock = 0;
my $endblock = 0;
my $triggerblock = '';
@@ -4262,7 +4268,8 @@ sub blockcheck {
# boards, chat or groups, check for blocking in current course only.
if (($activity eq 'boards' || $activity eq 'chat' ||
- $activity eq 'groups') && ($env{'request.course.id'})) {
+ $activity eq 'groups' || $activity eq 'printout') &&
+ ($env{'request.course.id'})) {
foreach my $key (keys(%live_courses)) {
if ($key ne $env{'request.course.id'}) {
delete($live_courses{$key});
@@ -4526,12 +4533,12 @@ sub parse_block_record {
}
sub blocking_status {
- my ($activity,$uname,$udom,$url) = @_;
+ my ($activity,$uname,$udom,$url,$is_course) = @_;
my %setters;
# check for active blocking
my ($startblock,$endblock,$triggerblock) =
- &blockcheck(\%setters,$activity,$uname,$udom,$url);
+ &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
my $blocked = 0;
if ($startblock && $endblock) {
$blocked = 1;
@@ -7425,7 +7432,7 @@ sub print_suppression {
}
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $blocked = &blocking_status('printout',$cnum,$cdom);
+ my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
if ($blocked) {
my $checkrole = "cm./$cdom/$cnum";
if ($env{'request.course.sec'} ne '') {
@@ -9899,7 +9906,15 @@ sub ask_for_embedded_content {
($path) =
($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
}
- $fileloc = &Apache::lonnet::filelocation('',$toplevel);
+ if ($toplevel=~/^\/*(uploaded|editupload)/) {
+ $fileloc = $toplevel;
+ $fileloc=~ s/^\s*(\S+)\s*$/$1/;
+ my ($udom,$uname,$fname) =
+ ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
+ $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
+ } else {
+ $fileloc = &Apache::lonnet::filelocation('',$toplevel);
+ }
$fileloc =~ s{^/}{};
($filename) = ($fileloc =~ m{.+/([^/]+)$});
$heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
@@ -14521,8 +14536,8 @@ sub init_user_environment {
}
# ------------------------------------ Check browser type and MathML capability
- my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
- $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
+ my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
+ $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
# ------------------------------------------------------------- Get environment
@@ -14555,6 +14570,7 @@ sub init_user_environment {
"browser.os" => $clientos,
"browser.mobile" => $clientmobile,
"browser.info" => $clientinfo,
+ "browser.osversion" => $clientosversion,
"server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
"request.course.fn" => '',
"request.course.uri" => '',
@@ -15226,36 +15242,6 @@ sub search_courses {
=cut
-sub build_release_hashes {
- my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
- return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
- (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
- (ref($randomizetry) eq 'HASH'));
- foreach my $key (keys(%Apache::lonnet::needsrelease)) {
- my ($item,$name,$value) = split(/:/,$key);
- if ($item eq 'parameter') {
- if (ref($checkparms->{$name}) eq 'ARRAY') {
- unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
- push(@{$checkparms->{$name}},$value);
- }
- } else {
- push(@{$checkparms->{$name}},$value);
- }
- } elsif ($item eq 'resourcetag') {
- if ($name eq 'responsetype') {
- $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
- }
- } elsif ($item eq 'course') {
- if ($name eq 'crstype') {
- $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
- }
- }
- }
- ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
- ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
- return;
-}
-
sub update_content_constraints {
my ($cdom,$cnum,$chome,$cid) = @_;
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
@@ -15632,6 +15618,26 @@ sub cleanup_html {
return $outgoing;
}
+# Checks for critical messages and returns a redirect url if one exists.
+# $interval indicates how often to check for messages.
+sub critical_redirect {
+ my ($interval) = @_;
+ if ((time-$env{'user.criticalcheck.time'})>$interval) {
+ my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
+ $env{'user.name'});
+ &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
+ my $redirecturl;
+ if ($what[0]) {
+ if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
+ $redirecturl='/adm/email?critical=display';
+ my $url=&Apache::lonnet::absolute_url().$redirecturl;
+ return (1, $url);
+ }
+ }
+ }
+ return ();
+}
+
# Use:
# my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
#