--- loncom/interface/loncommon.pm 2006/10/03 20:14:35 1.461
+++ loncom/interface/loncommon.pm 2007/08/24 18:41:06 1.568
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.461 2006/10/03 20:14:35 albertel Exp $
+# $Id: loncommon.pm,v 1.568 2007/08/24 18:41:06 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,16 +59,21 @@ use Apache::lonnet;
use GDBM_File;
use POSIX qw(strftime mktime);
use Apache::lonmenu();
+use Apache::lonenc();
use Apache::lonlocal;
use HTML::Entities;
use Apache::lonhtmlcommon();
use Apache::loncoursedata();
use Apache::lontexconvert();
use Apache::lonclonecourse();
-use LONCAPA;
+use LONCAPA qw(:DEFAULT :match);
+
+# ---------------------------------------------- Designs
+use vars qw(%defaultdesign);
my $readit;
+
##
## Global Variables
##
@@ -81,10 +86,6 @@ my %scprtag;
my %fe; my %fd; my %fm;
my %category_extensions;
-# ---------------------------------------------- Designs
-
-my %designhash;
-
# ---------------------------------------------- Thesaurus variables
#
# %Keywords:
@@ -150,30 +151,18 @@ BEGIN {
}
}
-# -------------------------------------------------------------- domain designs
-
- my $filename;
+# -------------------------------------------------------------- default domain designs
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
- opendir(DIR,$designdir);
- while ($filename=readdir(DIR)) {
- if ($filename!~/\.tab$/) { next; }
- my ($domain)=($filename=~/^(\w+)\./);
- {
- my $designfile = $designdir.'/'.$filename;
- if ( open (my $fh,"<$designfile") ) {
- while (my $line = <$fh>) {
- next if ($line =~ /^\#/);
- chomp($line);
- my ($key,$val)=(split(/\=/,$line));
- if ($val) { $designhash{$domain.'.'.$key}=$val; }
- }
- close($fh);
- }
- }
-
+ my $designfile = $designdir.'/default.tab';
+ if ( open (my $fh,"<$designfile") ) {
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\=/,$line));
+ if ($val) { $defaultdesign{$key}=$val; }
+ }
+ close($fh);
}
- closedir(DIR);
-
# ------------------------------------------------------------- file categories
{
@@ -345,10 +334,12 @@ sub studentbrowser_javascript {
return (<<'ENDSTDBRW');
+
+ function getFormIdByName(formname) {
+ for (var i=0;i".&mt('Select [_1]',$selecttype)."";
+ return "".&mt('Select Course')."";
}
sub check_uncheck_jscript {
@@ -461,7 +526,8 @@ function uncheckAll(field) {
if (field.length > 0) {
for (i = 0; i < field.length; i++) {
field[i].checked = false ;
- } } else {
+ }
+ } else {
field.checked = false ;
}
}
@@ -645,8 +711,7 @@ sub help_open_topic {
my ($topic, $text, $stayOnPage, $width, $height) = @_;
$text = "" if (not defined $text);
$stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'browser.interface'} eq 'textual' ||
- $env{'environment.remote'} eq 'off' ) {
+ if ($env{'browser.interface'} eq 'textual') {
$stayOnPage=1;
}
$width = 350 if (not defined $width);
@@ -738,12 +803,17 @@ ENDOUTPUT
# now just updates the help link and generates a blue icon
sub help_open_menu {
my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
- = @_;
-
+ = @_;
$stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'browser.interface'} eq 'textual' ||
- $env{'environment.remote'} eq 'off' ) {
- $stayOnPage=1;
+ # formerly only used pop-up help (stayOnPage = 0)
+ # if environment.remote is on (using remote control UI)
+ # if ($env{'browser.interface'} eq 'textual' ||
+ # $env{'environment.remote'} eq 'off' ) {
+ # $stayOnPage=1;
+ #}
+ # Now making pop-up help the default even with remote control
+ if ($env{'browser.interface'} eq 'textual') {
+ $stayOnPage=1;
}
my $output;
if ($component_help) {
@@ -1014,8 +1084,65 @@ sub changable_area {
=pod
-=back
+=item * resize_textarea_js
+
+emits the needed javascript to resize a textarea to be as big as possible
+
+creates a function resize_textrea that takes two IDs first should be
+the id of the element to resize, second should be the id of a div that
+surrounds everything that comes after the textarea, this routine needs
+to be attached to the for the onload and onresize events.
+
+
+=cut
+
+sub resize_textarea_js {
+ return <<"RESIZE";
+
+RESIZE
+
+}
+
+=pod
+
+=back
+
=head1 Excel and CSV file utility routines
=over 4
@@ -1149,7 +1276,7 @@ sub create_workbook {
=item * create_text_file
-Create a file to write to and eventually make available to the usre.
+Create a file to write to and eventually make available to the user.
If file creation fails, outputs an error message on the request object and
return undefs.
@@ -1190,41 +1317,19 @@ sub create_text_file {
## Home server
';
+ my $krb_msg = &mt('As you did not include the default Kerberos domain to be used for authentication in this class, the institutional data used by the automated enrollment process must include the Kerberos domain for each new student');
+ if ($context eq 'auto') {
+ $outcome .= $krb_msg;
+ } else {
+ $outcome .= ''.$krb_msg.'';
+ }
+ $outcome .= $linefeed;
}
}
if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
@@ -5849,9 +7246,11 @@ sub construct_course {
# if specified, key authority is not course, but user
# only active if keyaccess is yes
if ($args->{'keyauth'}) {
- $args->{'keyauth'}=~s/[^\w\@]//g;
- if ($args->{'keyauth'}) {
- $cenv{'keyauth'}=$args->{'keyauth'};
+ my ($user,$domain) = split(':',$args->{'keyauth'});
+ $user = &LONCAPA::clean_username($user);
+ $domain = &LONCAPA::clean_username($domain);
+ if ($user ne '' && $domain ne '') {
+ $cenv{'keyauth'}=$user.':'.$domain;
}
}
@@ -5879,8 +7278,8 @@ sub construct_course {
# By default, use standard grading
if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
- $outcome .= (' '.&mt('Setting environment').': '.
- &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).' ');
+ $outcome .= $linefeed.&mt('Setting environment').': '.
+ &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
#
# Open all assignments
#
@@ -5890,7 +7289,7 @@ sub construct_course {
$storeunder.'.type' => 'date_start');
$outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
- ('resourcedata',\%storecontent,$$crsudom,$$crsunum).' ';
+ ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
}
#
# Set first page
@@ -5917,9 +7316,10 @@ sub construct_course {
(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
if ($errtext) { $fatal=2; }
- $outcome .= ($fatal?$errtext:'write ok').' ';
+ $outcome .= ($fatal?$errtext:'write ok').$linefeed;
}
- return $outcome;
+
+ return (1,$outcome);
}
############################################################
@@ -5948,7 +7348,7 @@ sub group_term {
sub icon {
my ($file)=@_;
- my $curfext = (split(/\./,$file))[-1];
+ my $curfext = lc((split(/\./,$file))[-1]);
my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
my $embstyle = &Apache::loncommon::fileembstyle($curfext);
if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
@@ -6001,6 +7401,171 @@ sub escape_url {
my $lastitem = &escape(pop(@urlslices));
return join('/',@urlslices).'/'.$lastitem;
}
+
+# -------------------------------------------------------- Initliaze user login
+sub init_user_environment {
+ my ($r, $username, $domain, $authhost, $form, $args) = @_;
+ my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
+
+ my $public=($username eq 'public' && $domain eq 'public');
+
+# See if old ID present, if so, remove
+
+ my ($filename,$cookie,$userroles);
+ my $now=time;
+
+ if ($public) {
+ my $max_public=100;
+ my $oldest;
+ my $oldest_time=0;
+ for(my $next=1;$next<=$max_public;$next++) {
+ if (-e $lonids."/publicuser_$next.id") {
+ my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
+ if ($mtime<$oldest_time || !$oldest_time) {
+ $oldest_time=$mtime;
+ $oldest=$next;
+ }
+ } else {
+ $cookie="publicuser_$next";
+ last;
+ }
+ }
+ if (!$cookie) { $cookie="publicuser_$oldest"; }
+ } else {
+ # if this isn't a robot, kill any existing non-robot sessions
+ if (!$args->{'robot'}) {
+ opendir(DIR,$lonids);
+ while ($filename=readdir(DIR)) {
+ if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
+ unlink($lonids.'/'.$filename);
+ }
+ }
+ closedir(DIR);
+ }
+# Give them a new cookie
+ my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
+ : $now);
+ $cookie="$username\_$id\_$domain\_$authhost";
+
+# Initialize roles
+
+ $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
+ }
+# ------------------------------------ Check browser type and MathML capability
+
+ my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
+ $clientunicode,$clientos) = &decode_user_agent($r);
+
+# -------------------------------------- Any accessibility options to remember?
+ if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite') {
+ if ($form->{$option} eq 'true') {
+ &Apache::lonnet::put('environment',{$option => 'on'},
+ $domain,$username);
+ } else {
+ &Apache::lonnet::del('environment',[$option],
+ $domain,$username);
+ }
+ }
+ }
+# ------------------------------------------------------------- Get environment
+
+ my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
+ my ($tmp) = keys(%userenv);
+ if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+ # default remote control to off
+ if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
+ } else {
+ undef(%userenv);
+ }
+ if (($userenv{'interface'}) && (!$form->{'interface'})) {
+ $form->{'interface'}=$userenv{'interface'};
+ }
+ $env{'environment.remote'}=$userenv{'remote'};
+ if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
+
+# --------------- Do not trust query string to be put directly into environment
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite',
+ 'interface','localpath','localres') {
+ $form->{$option}=~s/[\n\r\=]//gs;
+ }
+# --------------------------------------------------------- Write first profile
+
+ {
+ my %initial_env =
+ ("user.name" => $username,
+ "user.domain" => $domain,
+ "user.home" => $authhost,
+ "browser.type" => $clientbrowser,
+ "browser.version" => $clientversion,
+ "browser.mathml" => $clientmathml,
+ "browser.unicode" => $clientunicode,
+ "browser.os" => $clientos,
+ "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
+ "request.course.fn" => '',
+ "request.course.uri" => '',
+ "request.course.sec" => '',
+ "request.role" => 'cm',
+ "request.role.adv" => $env{'user.adv'},
+ "request.host" => $ENV{'REMOTE_ADDR'},);
+
+ if ($form->{'localpath'}) {
+ $initial_env{"browser.localpath"} = $form->{'localpath'};
+ $initial_env{"browser.localres"} = $form->{'localres'};
+ }
+
+ if ($public) {
+ $initial_env{"environment.remote"} = "off";
+ }
+ if ($form->{'interface'}) {
+ $form->{'interface'}=~s/\W//gs;
+ $initial_env{"browser.interface"} = $form->{'interface'};
+ $env{'browser.interface'}=$form->{'interface'};
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite') {
+ if (($form->{$option} eq 'true') ||
+ ($userenv{$option} eq 'on')) {
+ $initial_env{"browser.$option"} = "on";
+ }
+ }
+ }
+
+ $env{'user.environment'} = "$lonids/$cookie.id";
+
+ if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
+ &GDBM_WRCREAT(),0640)) {
+ &_add_to_env(\%disk_env,\%initial_env);
+ &_add_to_env(\%disk_env,\%userenv,'environment.');
+ &_add_to_env(\%disk_env,$userroles);
+ if (ref($args->{'extra_env'})) {
+ &_add_to_env(\%disk_env,$args->{'extra_env'});
+ }
+ untie(%disk_env);
+ } else {
+ &Apache::lonnet::logthis("WARNING: ".
+ 'Could not create environment storage in lonauth: '.$!.'');
+ return 'error: '.$!;
+ }
+ }
+ $env{'request.role'}='cm';
+ $env{'request.role.adv'}=$env{'user.adv'};
+ $env{'browser.type'}=$clientbrowser;
+
+ return $cookie;
+
+}
+
+sub _add_to_env {
+ my ($idf,$env_data,$prefix) = @_;
+ while (my ($key,$value) = each(%$env_data)) {
+ $idf->{$prefix.$key} = $value;
+ $env{$prefix.$key} = $value;
+ }
+}
+
+
=pod
=back