--- loncom/interface/loncommon.pm 2011/01/05 19:57:17 1.948.2.23
+++ loncom/interface/loncommon.pm 2010/08/07 19:23:50 1.972
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.948.2.23 2011/01/05 19:57:17 raeburn Exp $
+# $Id: loncommon.pm,v 1.972 2010/08/07 19:23:50 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1072,7 +1072,7 @@ END
=pod
-=item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
+=item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
Returns a string corresponding to an HTML link to the given help
$topic, where $topic corresponds to the name of a .tex file in
@@ -1095,7 +1095,7 @@ be useful for certain help topics with b
=cut
sub help_open_topic {
- my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
+ my ($topic, $text, $stayOnPage, $width, $height) = @_;
$text = "" if (not defined $text);
$stayOnPage = 0 if (not defined $stayOnPage);
$width = 350 if (not defined $width);
@@ -1124,15 +1124,12 @@ sub help_open_topic {
# (Always) Add the graphic
my $title = &mt('Online Help');
my $helpicon=&lonhttpdurl("/adm/help/help.png");
- if ($imgid ne '') {
- $imgid = ' id="'.$imgid.'"';
- }
$template.=' '
.' ';
- if ($text ne "") {
+ if ($text ne "") {
$template.='';
}
return $template;
@@ -1205,12 +1202,7 @@ ENDOUTPUT
sub help_open_menu {
my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
= @_;
- $stayOnPage = 0 if (not defined $stayOnPage);
- # only use pop-up help (stayOnPage == 0)
- # if environment.remote is on (using remote control UI)
- if ($env{'environment.remote'} eq 'off' ) {
- $stayOnPage=1;
- }
+ $stayOnPage = 1;
my $output;
if ($component_help) {
if (!$text) {
@@ -1231,8 +1223,8 @@ sub help_open_menu {
sub top_nav_help {
my ($text) = @_;
$text = &mt($text);
- my $stay_on_page =
- ($env{'environment.remote'} eq 'off' );
+ my $stay_on_page = 1;
+
my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
: "javascript:helpMenu('open')";
my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
@@ -1247,10 +1239,7 @@ END
sub help_menu_js {
my ($text) = @_;
-
- my $stayOnPage =
- ($env{'environment.remote'} eq 'off' );
-
+ my $stayOnPage = 1;
my $width = 620;
my $height = 600;
my $helptopic=&general_help();
@@ -1307,10 +1296,7 @@ sub help_open_bug {
unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
$text = "" if (not defined $text);
- $stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
- }
$width = 600 if (not defined $width);
$height = 600 if (not defined $height);
@@ -1351,10 +1337,7 @@ sub help_open_faq {
unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
$text = "" if (not defined $text);
- $stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
- }
$width = 350 if (not defined $width);
$height = 400 if (not defined $height);
@@ -1870,7 +1853,7 @@ sub multiple_select_form {
Returns a string containing a form to
allow a user to select options from a ref to a hash containing:
option_name => displayed text. An optional $onchange can include
-a javascript onchange item, e.g., onchange="this.form.submit();"
+a javascript onchange item, e.g., onchange="this.form.submit();"
See lonrights.pm for an example invocation and use.
@@ -1886,9 +1869,9 @@ sub select_form {
my $selectform = "\n";
my @keys;
if (exists($hashref->{'select_form_order'})) {
- @keys=@{$hashref->{'select_form_order'}};
+ @keys=@{$hashref->{'select_form_order'}};
} else {
- @keys=sort(keys(%{$hashref}));
+ @keys=sort(keys(%{$hashref}));
}
foreach my $key (@keys) {
$selectform.=
@@ -2284,16 +2267,12 @@ function changed_text(choice,currentform
}
function set_auth_radio_buttons(newvalue,currentform) {
- var numauthchoices = currentform.login.length;
- if (typeof numauthchoices == "undefined") {
- return;
- }
var i=0;
- while (i < numauthchoices) {
+ while (i < currentform.login.length) {
if (currentform.login[i].value == newvalue) { break; }
i++;
}
- if (i == numauthchoices) {
+ if (i == currentform.login.length) {
return;
}
current.radiovalue = newvalue;
@@ -3260,7 +3239,7 @@ sub filemimetype {
sub filecategoryselect {
my ($name,$value)=@_;
return &select_form($value,$name,
- {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
+ {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
}
=pod
@@ -3425,21 +3404,17 @@ sub get_previous_attempt {
}
$prevattempts=&start_data_table().&start_data_table_header_row();
$prevattempts.=''.&mt('History').' ';
- my (%typeparts,%lasthidden);
+ my %typeparts;
my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
foreach my $key (sort(keys(%lasthash))) {
my ($ign,@parts) = split(/\./,$key);
if ($#parts > 0) {
my $data=$parts[-1];
- next if ($data eq 'foilorder');
pop(@parts);
if ($data eq 'type') {
unless ($showsurv) {
my $id = join(',',@parts);
$typeparts{$ign.'.'.$id} = $lasthash{$key};
- if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
- $lasthidden{$ign.'.'.$id} = 1;
- }
}
delete($lasthash{$key});
} else {
@@ -3454,6 +3429,7 @@ sub get_previous_attempt {
}
}
$prevattempts.=&end_data_table_header_row();
+ my %lasthidden;
if ($getattempt eq '') {
for ($version=1;$version<=$returnhash{'version'};$version++) {
my @hidden;
@@ -3461,6 +3437,11 @@ sub get_previous_attempt {
foreach my $id (keys(%typeparts)) {
if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
push(@hidden,$id);
+ $lasthidden{$id} = 1;
+ } elsif ($lasthidden{$id}) {
+ if (exists($returnhash{$version.':'.$id.'.award'})) {
+ delete($lasthidden{$id});
+ }
}
}
}
@@ -3468,7 +3449,6 @@ sub get_previous_attempt {
''.&mt('Transaction [_1]',$version).' ';
if (@hidden) {
foreach my $key (sort(keys(%lasthash))) {
- next if ($key =~ /\.foilorder$/);
my $hide;
foreach my $id (@hidden) {
if ($key =~ /^\Q$id\E/) {
@@ -3497,7 +3477,6 @@ sub get_previous_attempt {
}
} else {
foreach my $key (sort(keys(%lasthash))) {
- next if ($key =~ /\.foilorder$/);
my $value = &format_previous_attempt_value($key,
$returnhash{$version.':'.$key});
$prevattempts.=''.$value.' ';
@@ -3509,7 +3488,6 @@ sub get_previous_attempt {
my @currhidden = keys(%lasthidden);
$prevattempts.=&start_data_table_row().''.&mt('Current').' ';
foreach my $key (sort(keys(%lasthash))) {
- next if ($key =~ /\.foilorder$/);
if (%typeparts) {
my $hidden;
foreach my $id (@currhidden) {
@@ -3565,29 +3543,6 @@ sub format_previous_attempt_value {
$value = &Apache::lonlocal::locallocaltime($value);
} elsif (ref($value) eq 'ARRAY') {
$value = '('.join(', ', @{ $value }).')';
- } elsif ($key =~ /answerstring$/) {
- my %answers = &Apache::lonnet::str2hash($value);
- my @anskeys = sort(keys(%answers));
- if (@anskeys == 1) {
- my $answer = $answers{$anskeys[0]};
- if ($answer =~ m{\Q\0\E}) {
- $answer =~ s{\Q\0\E}{, }g;
- }
- my $tag_internal_answer_name = 'INTERNAL';
- if ($anskeys[0] eq $tag_internal_answer_name) {
- $value = $answer;
- } else {
- $value = $anskeys[0].'='.$answer;
- }
- } else {
- foreach my $ans (@anskeys) {
- my $answer = $answers{$ans};
- if ($answer =~ m{\Q\0\E}) {
- $answer =~ s{\Q\0\E}{, }g;
- }
- $value .= $ans.'='.$answer.' ';;
- }
- }
} else {
$value = &unescape($value);
}
@@ -3866,9 +3821,7 @@ sub findallcourses {
$udom = $env{'user.domain'};
}
if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
- my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
- my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,
- $extra);
+ my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
if (!%roles) {
%roles = (
cc => 1,
@@ -4496,7 +4449,7 @@ Returns: HTML div with $content
sub head_subbox {
my ($content)=@_;
my $output =
- ''
+ '
'
.$content
.'
'
}
@@ -4592,9 +4545,6 @@ Inputs:
=item * $bgcolor, used to override the bgcolor on a webpage to a specific value
-=item * $no_inline_link, if true and in remote mode, don't show the
- 'Switch To Inline Menu' link
-
=item * $args, optional argument valid values are
no_auto_mt_title -> prevents &mt()ing the title arg
inherit_jsmath -> when creating popup window in a page,
@@ -4612,7 +4562,7 @@ other decorations will be returned.
sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
- $no_nav_bar,$bgcolor,$no_inline_link,$args)=@_;
+ $no_nav_bar,$bgcolor,$args)=@_;
my $public;
if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
@@ -4654,8 +4604,6 @@ sub bodytag {
}
if (!$realm) { $realm=' '; }
-# Set messages
- my $messages=&domainlogo($domain);
my $extra_body_attr = &make_attr_string($forcereg,\%design);
@@ -4673,7 +4621,7 @@ sub bodytag {
} else {
$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
}
-
+
my $titleinfo = '
'.$title.' ';
#
# Extra info if you are the DC
@@ -4689,11 +4637,9 @@ sub bodytag {
$role = '
('.$role.') ' if $role;
&get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
- if ($env{'environment.remote'} ne 'on') {
- # No Remote
if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') {
- return $bodytag;
- }
+ return $bodytag;
+ }
if ($env{'request.state'} eq 'construct') { $forcereg=1; }
@@ -4711,10 +4657,6 @@ sub bodytag {
$realm $dc_info
|;
return $bodytag;
}
- if (($env{'request.noversionuri'} =~ m{^/adm/navmaps}) &&
- ($env{'environment.remotenavmap'} eq 'on')) {
- return $bodytag;
- }
unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
$bodytag .= qq|$name $role
|;
@@ -4736,7 +4678,7 @@ sub bodytag {
$bodytag .= Apache::lonmenu::serverform();
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
if ($env{'request.state'} eq 'construct') {
- $bodytag .= &Apache::lonmenu::innerregister($forcereg,'',
+ $bodytag .= &Apache::lonmenu::innerregister($forcereg,
$args->{'bread_crumbs'});
} elsif ($forcereg) {
$bodytag .= &Apache::lonmenu::innerregister($forcereg);
@@ -4749,45 +4691,11 @@ sub bodytag {
}
return $bodytag;
- }
-
-#
-# Top frame rendering, Remote is up
-#
-
- my $imgsrc = $img;
- if ($img =~ /^\/adm/) {
- $imgsrc = &lonhttpdurl($img);
- }
- my $upperleft=' ';
-
- # Explicit link to get inline menu
- my $menu= ($no_inline_link?''
- :''.&mt('Switch to Inline Menu Mode').' ');
-
- if ($dc_info) {
- $dc_info = qq|($dc_info) |;
- }
-
- $bodytag .= qq|$name $role
- $realm $dc_info
| unless $env{'form.inhibitmenu'};
- return(<
-$upperleft
- $messages
-
-$titleinfo $dc_info $menu
-
-
-ENDBODY
}
sub dc_courseid_toggle {
my ($dc_info) = @_;
- return ' '.
+ return ' '.
''.
&mt('(More ...)').' '.
''.$dc_info.'
';
@@ -4814,22 +4722,8 @@ sub make_attr_string {
delete($attr_ref->{$key});
}
}
- $attr_ref->{'onload'} =
- &Apache::lonmenu::loadevents(). $on_load;
- $attr_ref->{'onunload'}=
- &Apache::lonmenu::unloadevents().$on_unload;
- }
-
-# Accessibility font enhance
- if ($env{'browser.fontenhance'} eq 'on') {
- my $style;
- foreach my $key (keys(%{$attr_ref})) {
- if (lc($key) eq 'style') {
- $style.=$attr_ref->{$key}.';';
- delete($attr_ref->{$key});
- }
- }
- $attr_ref->{'style'}=$style.'; font-size: x-large;';
+ $attr_ref->{'onload'} = $on_load;
+ $attr_ref->{'onunload'}= $on_unload;
}
my $attr_string;
@@ -4927,6 +4821,7 @@ sub standard_css {
$env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
: '0 3px 0 4px';
+
return <{'frameset'}) {
$result .= &Apache::lonhtmlcommon::htmlareaheaders();
}
- if ($args->{'force_register'}) {
- $result .= &Apache::lonmenu::registerurl(1);
+ if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
+ $result .= Apache::lonxml::display_title();
}
if (!$args->{'no_nav_bar'}
&& !$args->{'only_body'}
@@ -6709,7 +6550,7 @@ ADDMETA
$result .= ' LON-CAPA '.$title.' '
.' '
.$head_extra;
- return $result;
+ return $result.'';
}
=pod
@@ -6762,43 +6603,6 @@ sub xml_begin {
=pod
-=item * &endheadtag()
-
-Returns a uniform for LON-CAPA web pages.
-
-Inputs: none
-
-=cut
-
-sub endheadtag {
- return '';
-}
-
-=pod
-
-=item * &head()
-
-Returns a uniform complete .. section for LON-CAPA web pages.
-
-Inputs:
-
-=over 4
-
-$title - optional title for the page
-
-$head_extra - optional extra HTML to put inside the
-
-=back
-
-=cut
-
-sub head {
- my ($title,$head_extra,$args) = @_;
- return &headtag($title,$head_extra,$args).&endheadtag();
-}
-
-=pod
-
=item * &start_page()
Returns a complete .. section for LON-CAPA web pages.
@@ -6836,14 +6640,12 @@ $args - additional optional args support
skip_phases -> hash ref of
head -> skip the generation
body -> skip all 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
+ bread_crumbs_components -> if exists show it as headline else show only the breadcrumbs
=back
@@ -6854,6 +6656,14 @@ $args - additional optional args support
sub start_page {
my ($title,$head_extra,$args) = @_;
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
+#SD
+#I don't see why we copy certain elements of %$args to %head_args
+#head args is passed to headtag() and this routine only reads those
+#keys that are needed. There doesn't happen any writes or any processing
+#of other keys.
+#proposal: just pass $args to headtag instead of \%head_args and delete
+#marked lines
+#<- MARK
my %head_args;
foreach my $arg ('redirect','force_register','domain','function',
'bgcolor','frameset','no_nav_bar','only_body',
@@ -6862,13 +6672,16 @@ sub start_page {
$head_args{$arg} = $args->{$arg};
}
}
+#MARK ->
$env{'internal.start_page'}++;
my $result;
+
if (! exists($args->{'skip_phases'}{'head'}) ) {
- $result.=
- &xml_begin().
- &headtag($title,$head_extra,\%head_args).&endheadtag();
+ $result .=
+ &xml_begin() . &headtag($title,$head_extra,\%head_args);
+#replace prev line by
+# &xml_begin() . &headtag($title, $head_extra, $args);
}
if (! exists($args->{'skip_phases'}{'body'}) ) {
@@ -6882,8 +6695,7 @@ sub start_page {
$args->{'function'}, $args->{'add_entries'},
$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'no_nav_bar'},
- $args->{'bgcolor'}, $args->{'no_inline_link'},
- $args);
+ $args->{'bgcolor'}, $args);
}
}
@@ -6899,14 +6711,10 @@ sub start_page {
# $result .= &build_functionlist();
#}
- # Don't add anything more if only_body wanted
- return $result if $args->{'only_body'};
+ # Don't add anything more if only_body wanted or in const space
+ return $result if $args->{'only_body'}
+ || $env{'request.state'} eq 'construct';
- #Breadcrumbs for Construction Space provided by &bodytag.
- if (($env{'environment.remote'} eq 'off') && ($env{'request.state'} eq 'construct')) {
- return $result;
- }
-
#Breadcrumbs
if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
&Apache::lonhtmlcommon::clear_breadcrumbs();
@@ -6927,28 +6735,6 @@ sub start_page {
return $result;
}
-
-=pod
-
-=item * &head()
-
-Returns a complete section for LON-CAPA web pages.
-
-Inputs: $args - additional optional args supported are:
- js_ready -> return a string ready for being used in
- a javascript writeln
- html_encode -> return a string ready for being used in
- a html attribute
- frameset -> if true will start with a
- rather than
- dicsussion -> if true will get discussion from
- lonxml::xmlend
- (you can pass the target and parser arguments
- through optional 'target' and 'parser' args
- to this routine)
-
-=cut
-
sub end_page {
my ($args) = @_;
$env{'internal.end_page'}++;
@@ -7052,12 +6838,12 @@ sub simple_error_page {
sub start_data_table {
my ($add_class) = @_;
my $css_class = (join(' ','LC_data_table',$add_class));
- &start_data_table_count();
+ &start_data_table_count();
return ''."\n";
}
sub end_data_table {
- &end_data_table_count();
+ &end_data_table_count();
return '
'."\n";;
}
@@ -7236,8 +7022,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';
@@ -7820,7 +7605,7 @@ sub get_secgrprole_info {
}
sub user_picker {
- my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
+ my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
my $currdom = $dom;
my %curr_selected = (
srchin => 'dom',
@@ -7911,15 +7696,10 @@ sub user_picker {
$srchtypesel .= "\n \n";
my ($newuserscript,$new_user_create);
- my $context_dom = $env{'request.role.domain'};
- if ($context eq 'requestcrs') {
- if ($env{'form.coursedom'} ne '') {
- $context_dom = $env{'form.coursedom'};
- }
- }
+
if ($forcenewuser) {
if (ref($srch) eq 'HASH') {
- if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
+ if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
if ($cancreate) {
$new_user_create = ' &"').'" onclick="javascript:setSearch(\'1\','.$caller.');" />
';
} else {
@@ -7958,7 +7738,7 @@ function setSearch(createnew,callingForm
}
}
for (var i=0; i';
+ $upload_output .= $state;
+ $upload_output .= 'Upload embedded files : '.&start_data_table();
+
my $num = 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 $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'};
- $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
- } else {
- $udom = $env{'user.domain'};
- $uname = $env{'user.name'};
- $url = '/userfiles/portfolio';
- }
- $toplevel = $url.'/';
- $url .= $current_path;
- $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/';
- $toplevel = $url;
- if ($rest ne '') {
- $url .= $rest;
- }
- } elsif ($actionurl eq '/adm/coursedocs') {
- if (ref($args) eq 'HASH') {
- $url = $args->{'docs_url'};
- $toplevel = $url;
- }
- }
- my $now = time();
- foreach my $embed_file (keys(%{$allfiles})) {
- my $absolutepath;
- if ($embed_file =~ m{^\w+://}) {
- $newfiles{$embed_file} = 1;
- $mapping{$embed_file} = $embed_file;
- } else {
- if ($embed_file =~ m{^/}) {
- $absolutepath = $embed_file;
- $embed_file =~ s{^(/+)}{};
- }
- if ($embed_file =~ m{/}) {
- my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
- $path = &check_for_traversal($path,$url,$toplevel);
- my $item = $fname;
- if ($path ne '') {
- $item = $path.'/'.$fname;
- $subdependencies{$path}{$fname} = 1;
- } else {
- $dependencies{$item} = 1;
- }
- if ($absolutepath) {
- $mapping{$item} = $absolutepath;
- } else {
- $mapping{$item} = $embed_file;
- }
- } else {
- $dependencies{$embed_file} = 1;
- if ($absolutepath) {
- $mapping{$embed_file} = $absolutepath;
- } else {
- $mapping{$embed_file} = $embed_file;
- }
- }
- }
- }
- 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;
- }
- } 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;
- }
- }
- foreach my $file (keys(%{$subdependencies{$path}})) {
- if ($currsubfile{$file}) {
- my $item = $path.'/'.$file;
- unless ($mapping{$item} eq $item) {
- $pathchanges{$item} = 1;
- }
- $existing{$item} = 1;
- $numexisting ++;
- } else {
- $newfiles{$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;
- }
- } 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;
- }
- }
- foreach my $file (keys(%dependencies)) {
- if ($currfile{$file}) {
- unless ($mapping{$file} eq $file) {
- $pathchanges{$file} = 1;
- }
- $existing{$file} = 1;
- $numexisting ++;
- } else {
- $newfiles{$file} = 1;
- }
- }
- foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
+ foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
$upload_output .= &start_data_table_row().
- ''.$embed_file.' ';
- unless ($mapping{$embed_file} eq $embed_file) {
- $upload_output .= ''.&mt('changed from: [_1]',$mapping{$embed_file}).' ';
- }
- $upload_output .= '';
+ ' '.$embed_file.' ';
if ($args->{'ignore_remote_references'}
&& $embed_file =~ m{^\w+://}) {
$upload_output.=''.&mt("URL points to other server.").' ';
- $numremref++;
} elsif ($args->{'error_on_invalid_names'}
&& $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
- $upload_output.=''.&mt('Invalid characters').' ';
- $numinvalid++;
+ $upload_output.=''.&mt("Invalid characters").' ';
+
} else {
- $upload_output .= &embedded_file_element('upload_embedded',$num,
- $embed_file,\%mapping,
- $allfiles,$codebase);
- $num++;
- }
- $upload_output .= ' '.&Apache::loncommon::end_data_table_row()."\n";
- }
- foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
- $upload_output .= &start_data_table_row().
- ''.$embed_file.' '.
- ''.&mt('Already exists').' '.
- &Apache::loncommon::end_data_table_row()."\n";
- }
- if ($upload_output) {
- $upload_output = &start_data_table().
- $upload_output.
- &end_data_table()."\n";
- }
- my $applies = 0;
- if ($numremref) {
- $applies ++;
- }
- if ($numinvalid) {
- $applies ++;
- }
- if ($numexisting) {
- $applies ++;
- }
- if ($num) {
- $output = ''."\n";
- } elsif ($numpathchg) {
- my %pathchange = ();
- $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
- if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
- $output .= ''.&mt('or').'
';
- }
- }
- return ($output,$num,$numpathchg);
-}
-
-sub embedded_file_element {
- my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;
- return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
- (ref($codebase) eq 'HASH'));
- my $output;
- if ($context eq 'upload_embedded') {
- $output = ' '."\n";
- }
- $output .= ' ';
- unless (($context eq 'upload_embedded') &&
- ($mapping->{$embed_file} eq $embed_file)) {
- $output .='
- ';
- }
- my $attrib;
- if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
- $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
- }
- $output .=
- "\n\t\t".
- ' ';
- if (exists($codebase->{$mapping->{$embed_file}})) {
- $output .=
- "\n\t\t".
- ' ';
- }
- return $output;
+ $upload_output .='
+
+ ';
+ my $attrib = join(':',@{$$allfiles{$embed_file}});
+ $upload_output .=
+ "\n\t\t".
+ ' ';
+ if (exists($$codebase{$embed_file})) {
+ $upload_output .=
+ "\n\t\t".
+ ' ';
+ }
+ }
+ $upload_output .= ''.&Apache::loncommon::end_data_table_row();
+ $num++;
+ }
+ $upload_output .= &Apache::loncommon::end_data_table().'
+
+
+ '.&mt('(only files for which a location has been provided will be uploaded)').'
+ ';
+ return $upload_output;
}
sub upload_embedded {
my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
- $current_disk_usage,$hiddenstate,$actionurl) = @_;
- my (%pathchange,$output,$modifyform,$footer,$returnflag);
+ $current_disk_usage) = @_;
+ my $output;
for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
my $orig_uploaded_filename =
$env{'form.embedded_item_'.$i.'.filename'};
- foreach my $type ('orig','ref','attrib','codebase') {
- if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
- $env{'form.embedded_'.$type.'_'.$i} =
- &unescape($env{'form.embedded_'.$type.'_'.$i});
- }
- }
+
+ $env{'form.embedded_orig_'.$i} =
+ &unescape($env{'form.embedded_orig_'.$i});
my ($path,$fname) =
($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
# no path, whole string is fname
if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
+
+ $path = $env{'form.currentpath'}.$path;
$fname = &Apache::lonnet::clean_filename($fname);
# See if there is anything left
next if ($fname eq '');
@@ -8788,12 +8329,12 @@ sub upload_embedded {
if ($group ne '') {
$port_path = "groups/$group/$port_path";
}
- ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
- $fname,$group,'embedded_item_'.$i,
+ ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
$dir_root,$port_path,$disk_quota,
$current_disk_usage,$uname,$udom);
if ($state eq 'will_exceed_quota'
- || $state eq 'file_locked') {
+ || $state eq 'file_locked'
+ || $state eq 'file_exists' ) {
$output .= $msg;
next;
}
@@ -8807,53 +8348,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 LONCAPA use - rename the file with a different extension and re-upload. ',$1);
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).' ';
+ $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('File name 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;
if ($context eq 'portfolio') {
- my $result;
- if ($state eq 'existingfile') {
- $result=
- &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
- $dirpath.$env{'form.currentpath'}.$path);
- } else {
- $result=
- &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
- $dirpath.
- $env{'form.currentpath'}.$path);
- if ($result !~ m|^/uploaded/|) {
- $output .= ''
- .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
- ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
- .' ';
- next;
- } else {
- $output .= &mt('Uploaded [_1]',''.
- $path.$fname.' ').' ';
- }
- }
- } elsif ($context eq 'coursedoc') {
- my $result =
- &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
- $dirpath.'/'.$path);
+ my $result=
+ &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
+ $dirpath.$path);
if ($result !~ m|^/uploaded/|) {
$output .= ''
- .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
+ .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
- .' ';
- next;
+ .' ';
+ next;
} else {
- $output .= &mt('Uploaded [_1]',''.
- $path.$fname.' ').' ';
+ $output .= ''.&mt('Uploaded [_1]',''.
+ $path.$fname.' ').'
';
}
} else {
# Save the file
@@ -8883,189 +8402,18 @@ sub upload_embedded {
&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]',''.
- $url.' ').' ';
- unless ($context eq 'testbank') {
- $footer .= &mt('View embedded file: [_1]',
- ''.$fname.' ').' ';
- }
- }
- close($fh);
- }
- }
- if ($env{'form.embedded_ref_'.$i}) {
- $pathchange{$i} = 1;
- }
- }
- if ($output) {
- $output = ''.$output.'
';
- }
- $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
- $returnflag = 'ok';
- if (keys(%pathchange) > 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).','',' ').'
';
- $returnflag = 'modify_orightml';
- }
- }
- return ($output.$footer,$returnflag);
-}
-
-sub modify_html_form {
- my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
- my $end = 0;
- my $modifyform;
- if ($context eq 'upload_embedded') {
- return unless (ref($pathchange) eq 'HASH');
- if ($env{'form.number_embedded_items'}) {
- $end += $env{'form.number_embedded_items'};
- }
- if ($env{'form.number_pathchange_items'}) {
- $end += $env{'form.number_pathchange_items'};
- }
- if ($end) {
- for (my $i=0; $i<$end; $i++) {
- if ($i < $env{'form.number_embedded_items'}) {
- next unless($pathchange->{$i});
- }
- $modifyform .=
- &start_data_table_row().
- ' '.
- ''.$env{'form.embedded_ref_'.$i}.
- ' '.
- ' '.
- ' '.
- ''.$env{'form.embedded_orig_'.$i}.
- ' '.
- &end_data_table_row();
- }
- }
- } else {
- $modifyform = $pathchgtable;
- if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
- $hiddenstate .= ' ';
- } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
- $hiddenstate .= ' ';
- }
- }
- if ($modifyform) {
- 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".
- ''.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').' '."\n".
- '
'."\n".''.
- &mt('LON-CAPA can make the required changes to your HTML file.').'
'."\n".
- ''."\n";
- }
- return;
-}
-
-sub modify_html_refs {
- my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
- my $container;
- if ($context eq 'portfolio') {
- $container = $env{'form.container'};
- } elsif ($context eq 'coursedoc') {
- $container = $env{'form.primaryurl'};
- } else {
- $container = $env{'form.filename'};
- $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2};
- }
- 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/});
- $content = &Apache::lonnet::getfile($container);
- return if ($content eq '-1');
- } else {
- return unless ($container =~ /^\Q$dir_root\E/);
- if (open(my $fh,"<$container")) {
- $content = join('', <$fh>);
- close($fh);
- } else {
- return;
- }
- }
- my ($count,$codebasecount) = (0,0);
- my $mm = new File::MMagic;
- my $mime_type = $mm->checktype_contents($content);
- if ($mime_type eq 'text/html') {
- my $parse_result =
- &Apache::lonnet::extract_embedded_items($container,\%allfiles,
- \%codebase,\$content);
- if ($parse_result eq 'ok') {
- foreach my $i (@changes) {
- my $orig = &unescape($env{'form.embedded_orig_'.$i});
- my $ref = &unescape($env{'form.embedded_ref_'.$i});
- if ($allfiles{$ref}) {
- my $newname = $orig;
- my ($attrib_regexp,$codebase);
- my $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
- if ($attrib_regexp =~ /:/) {
- $attrib_regexp =~ s/\:/|/g;
- }
- 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;
- }
- if ($env{'form.embedded_codebase_'.$i} ne '') {
- my $codebase = &unescape($env{'form.embedded_codebase_'.$i});
- my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
- $codebasecount ++;
- }
- }
- }
- if ($count || $codebasecount) {
- my $saveresult;
- if ($context eq 'portfolio' || $context eq 'coursedoc') {
- 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.' ').'
';
- } else {
- $output = ''.
- &mt('Error: update failed for: [_1].',
- ''.
- $container.' ').'
';
- }
- } else {
- if (open(my $fh,">$container")) {
- print $fh $content;
- close($fh);
- $output = ''.&mt('Updated [quant,_1,reference] in [_2].',
- $count,''.
- $container.' ').'
';
+ if ($context eq 'testbank') {
+ $output .= &mt('Embedded file uploaded successfully:').
+ ' '.
+ $orig_uploaded_filename.' ';
} else {
- $output = ''.
- &mt('Error: could not update [_1].',
- ''.
- $container.' ').'
';
+ $output .= ''.
+ &mt('View embedded file: [_1]',''.
+ $orig_uploaded_filename.' ').' ';
}
}
+ close($fh);
}
- } else {
- &logthis('Failed to parse '.$container.
- ' to modify references: '.$parse_result);
}
}
return $output;
@@ -9090,71 +8438,22 @@ sub check_for_existing {
sub check_for_upload {
my ($path,$fname,$group,$element,$portfolio_root,$port_path,
$disk_quota,$current_disk_usage,$uname,$udom) = @_;
- my $filesize = length($env{'form.'.$element});
- if (!$filesize) {
- my $msg = ''.
- &mt('Unable to upload [_1]. (size = [_2] bytes)',
- ''.$fname.' ',
- $filesize).' '.
- &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').' ';
- ' ';
- return ('zero_bytes',$msg);
- }
- $filesize = $filesize/1000; #express in k (1024?)
+ my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
my $getpropath = 1;
my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
$getpropath);
my $found_file = 0;
my $locked_file = 0;
- my @lockers;
- my $navmap;
- if ($env{'request.course.id'}) {
- $navmap = Apache::lonnavmaps::navmap->new();
- }
foreach my $line (@dir_list) {
- my ($file_name,$rest)=split(/\&/,$line,2);
+ my ($file_name)=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 {
- 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);
- }
- }
+ if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
+ $locked_file = 1;
}
}
}
@@ -9172,55 +8471,15 @@ sub check_for_upload {
return ('file_locked',$msg);
} else {
my $msg = '';
- $msg .= &mt(' A file by that name: [_1] was found in [_2].',''.$fname.' ',$port_path.$env{'form.currentpath'});
+ $msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].',''.$fname.' ',$port_path.$env{'form.currentpath'});
$msg .= ' ';
- return ('existingfile',$msg);
+ $msg .= ' ';
+ $msg .= &mt('To upload, rename or delete existing [_1] in [_2].',''.$fname.' ', $port_path.$env{'form.currentpath'});
+ return ('file_exists',$msg);
}
}
}
-sub check_for_traversal {
- my ($path,$url,$toplevel) = @_;
- my @parts=split(/\//,$path);
- my $cleanpath;
- my $fullpath = $url;
- for (my $i=0;$i<@parts;$i++) {
- next if ($parts[$i] eq '.');
- if ($parts[$i] eq '..') {
- $fullpath =~ s{([^/]+/)$}{};
- } else {
- $fullpath .= $parts[$i].'/';
- }
- }
- if ($fullpath =~ /^\Q$url\E(.*)$/) {
- $cleanpath = $1;
- } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
- my $curr_toprel = $1;
- my @parts = split(/\//,$curr_toprel);
- my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
- my @urlparts = split(/\//,$url_toprel);
- my $doubledots;
- my $startdiff = -1;
- for (my $i=0; $i<@urlparts; $i++) {
- if ($startdiff == -1) {
- unless ($urlparts[$i] eq $parts[$i]) {
- $startdiff = $i;
- $doubledots .= '../';
- }
- } else {
- $doubledots .= '../';
- }
- }
- if ($startdiff > -1) {
- $cleanpath = $doubledots;
- for (my $i=$startdiff; $i<@parts; $i++) {
- $cleanpath .= $parts[$i].'/';
- }
- }
- }
- $cleanpath =~ s{(/)$}{};
- return $cleanpath;
-}
=pod
@@ -11143,6 +10402,8 @@ sub construct_course {
############################################################
############################################################
+#SD
+# only Community and Course, or anything else?
sub course_type {
my ($cid) = @_;
if (!defined($cid)) {
@@ -11308,15 +10569,12 @@ sub init_user_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
@@ -11348,28 +10606,21 @@ sub init_user_environment {
$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'};
}
- my %is_adv = ( is_adv => $env{'user.adv'} );
- my %domdef = &Apache::lonnet::get_domain_defaults($domain);
foreach my $tool ('aboutme','blog','portfolio') {
$userenv{'availabletools.'.$tool} =
- &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
- undef,\%userenv,\%domdef,\%is_adv);
+ &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
}
foreach my $crstype ('official','unofficial','community') {
$userenv{'canrequest.'.$crstype} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,
- 'reload','requestcourses',
- \%userenv,\%domdef,\%is_adv);
+ 'reload','requestcourses');
}
$env{'user.environment'} = "$lonids/$cookie.id";
@@ -11448,36 +10699,6 @@ sub clean_symb {
return ($symb,$enc);
}
-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;
-}
-
=pod
=back