--- loncom/interface/loncommon.pm 2013/07/15 17:42:11 1.1140 +++ loncom/interface/loncommon.pm 2013/08/07 00:03:25 1.1143 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1140 2013/07/15 17:42:11 raeburn Exp $ +# $Id: loncommon.pm,v 1.1143 2013/08/07 00:03:25 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2351,6 +2351,8 @@ Outputs: =item * $clientmobile +=item * $clientinfo + =back =back @@ -2381,6 +2383,7 @@ sub decode_user_agent { } } my $clientos='unknown'; + my $clientinfo; if (($httpbrowser=~/linux/i) || ($httpbrowser=~/unix/i) || ($httpbrowser=~/ux/i) || @@ -2395,8 +2398,13 @@ sub decode_user_agent { if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) { $clientmobile=lc($1); } + if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) { + $clientinfo = 'firefox-'.$1; + } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) { + $clientinfo = 'chromeframe-'.$1; + } return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, - $clientunicode,$clientos,$clientmobile); + $clientunicode,$clientos,$clientmobile,$clientinfo); } ############################################################### @@ -3066,6 +3074,8 @@ sub get_related_words { =pod +=back + =head1 Spell checking =over 4 @@ -3099,12 +3109,6 @@ Note: This sub assumes that aspell is in =cut -=pod - -=back - -=cut - sub check_spelling { my ($wordlist, $language) = @_; my @misspellings; @@ -3320,7 +3324,7 @@ sub screenname { # ------------------------------------------------------------- Confirm Wrapper =pod -=item confirmwrapper +=item * &confirmwrapper($message) Wrap messages about completion of operation in box @@ -8778,6 +8782,7 @@ 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.) @@ -8788,6 +8793,7 @@ Incoming parameters: (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. @@ -8801,8 +8807,6 @@ If the user's status includes multiple t the largest default quota which applies to the user determines the default quota returned. -=back - =cut ############################################### @@ -8894,7 +8898,9 @@ Inputs: 6 6. action being taken: copy or upload. Returns: 1 scalar: HTML to display containing warning if quota would be exceeded, - otherwise return null. + otherwise return null. + +=back =cut @@ -14285,7 +14291,7 @@ sub init_user_environment { # ------------------------------------ Check browser type and MathML capability my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, - $clientunicode,$clientos,$clientmobile) = &decode_user_agent($r); + $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r); # ------------------------------------------------------------- Get environment @@ -14317,6 +14323,7 @@ sub init_user_environment { "browser.unicode" => $clientunicode, "browser.os" => $clientos, "browser.mobile" => $clientmobile, + "browser.info" => $clientinfo, "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'}, "request.course.fn" => '', "request.course.uri" => '', @@ -14569,6 +14576,30 @@ sub parse_supplemental_title { return $title; } +sub recurse_supplemental { + my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_; + if ($suppmap) { + my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); + if ($fatal) { + $errors ++; + } else { + if ($#LONCAPA::map::resources > 0) { + foreach my $res (@LONCAPA::map::resources) { + my ($title,$src,$ext,$type,$status)=split(/\:/,$res); + if (($src ne '') && ($status eq 'res')) { + if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_/d+\.sequence)$}) { + $numfiles = &recurse_supplemental($cnum,$cdom,$1,$numfiles); + } else { + $numfiles ++; + } + } + } + } + } + } + return ($numfiles,$errors); +} + sub symb_to_docspath { my ($symb) = @_; return unless ($symb);