need to clean
+ # up if it did
+ &Apache::structuretags::reset_problem_globals();
+ &Apache::lonhomework::finished_parsing();
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['rawmode']);
+ if ($env{'form.rawmode'}) { $result = $filecontents; }
+ if ($filetype eq 'sty') {
+ my $controls =
+ ($env{'request.state'} eq 'construct') ? &Apache::londefdef::edit_controls()
+ : '';
+ my %options = ('bgcolor' => '#FFFFFF');
+ $result =
+ &Apache::loncommon::start_page(undef,undef,\%options).
+ $controls.
+ $result.
+ &Apache::loncommon::end_page();
+ }
}
}
-
+
#
# Edit action? Insert editing commands
#
- unless ($ENV{'request.state'} eq 'published') {
- if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {
+ unless ($env{'request.state'} eq 'published') {
+ if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
+ {
my $displayfile=$request->uri;
$displayfile=~s/^\/[^\/]*//;
- my $bodytag='';
- if ($ENV{'environment.remote'} eq 'off') {
- $bodytag=&Apache::loncommon::bodytag();
+
+ my ($edit_info, $add_to_onload, $add_to_onresize)=
+ &inserteditinfo($filecontents,$filetype,$displayfile);
+
+ my %options =
+ ('add_entries' =>
+ {'onresize' => $add_to_onresize,
+ 'onload' => $add_to_onload, });
+
+ if ($env{'environment.remote'} ne 'off') {
+ $options{'bgcolor'} = '#FFFFFF';
+ $options{'only_body'} = 1;
}
- $result=''.$bodytag.
- &Apache::lonxml::message_location().''.
- $displayfile.
- '
';
- $result=&inserteditinfo($result,$filecontents,$filetype);
+ my $js =
+ &Apache::edit::js_change_detection().
+ &Apache::loncommon::resize_textarea_js();
+ my $start_page = &Apache::loncommon::start_page(undef,$js,
+ \%options);
+ $result=$start_page.
+ &Apache::lonxml::message_location().
+ $edit_info.
+ &Apache::loncommon::end_page();
}
}
- if ($filetype eq 'html') { writeallows($request->uri); }
-
+ if ($filetype eq 'html') { &writeallows($request->uri); }
&Apache::lonxml::add_messages(\$result);
$request->print($result);
@@ -1405,13 +1788,14 @@ ENDNOTFOUND
sub display_title {
my $result;
- if ($ENV{'request.state'} eq 'construct') {
+ if ($env{'request.state'} eq 'construct') {
my $title=&Apache::lonnet::gettitle();
if (!defined($title) || $title eq '') {
- $title = $ENV{'request.filename'};
+ $title = $env{'request.filename'};
$title = substr($title, rindex($title, '/') + 1);
}
- $result = "";
+ $result = "";
}
return $result;
}
@@ -1420,56 +1804,104 @@ sub debug {
if ($Apache::lonxml::debug eq "1") {
$|=1;
my $request=$Apache::lonxml::request;
- if (!$request) { $request=Apache->request; }
+ if (!$request) {
+ eval { $request=Apache->request; };
+ }
+ if (!$request) {
+ eval { $request=Apache2::RequestUtil->request; };
+ }
$request->print('DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."
\n");
#&Apache::lonnet::logthis($_[0]);
}
}
sub show_error_warn_msg {
- if ($ENV{'request.filename'} eq '/home/httpd/html/res/lib/templates/simpleproblem.problem' &&
- &Apache::lonnet::allowed('mdc',$ENV{'request.course.id'})) {
+ if ($env{'request.filename'} eq '/home/httpd/html/res/lib/templates/simpleproblem.problem' &&
+ &Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
return 1;
}
return (($Apache::lonxml::debug eq 1) ||
- ($ENV{'request.state'} eq 'construct') ||
+ ($env{'request.state'} eq 'construct') ||
($Apache::lonhomework::browse eq 'F'
&&
- $ENV{'form.show_errors'} eq 'on'));
+ $env{'form.show_errors'} eq 'on'));
}
sub error {
+ my @errors = @_;
+
$errorcount++;
+
+ $Apache::lonxml::internal_error=1;
+
+ if (defined($Apache::inputtags::part)) {
+ if ( @Apache::inputtags::response ) {
+ push(@errors,
+ &mt("This error occurred while processing response [_1] in part [_2]",
+ $Apache::inputtags::response[-1],
+ $Apache::inputtags::part));
+ } else {
+ push(@errors,
+ &mt("This error occurred while processing part [_1]",
+ $Apache::inputtags::part));
+ }
+ }
+
if ( &show_error_warn_msg() ) {
# If printing in construction space, put the error inside
push(@Apache::lonxml::error_messages,
- $Apache::lonxml::warnings_error_header.
- "ERROR:".join("
\n",@_)."
\n");
+ $Apache::lonxml::warnings_error_header
+ .''
+ .''.&mt('ERROR:').' '.join("
\n",@errors)
+ ."
\n");
$Apache::lonxml::warnings_error_header='';
} else {
my $errormsg;
my ($symb)=&Apache::lonnet::symbread();
if ( !$symb ) {
#public or browsers
- $errormsg=&mt("An error occured while processing this resource. The author has been notified.");
- }
+ $errormsg=&mt("An error occurred while processing this resource. The author has been notified.");
+ }
+ my $host=$Apache::lonnet::perlvar{'lonHostID'};
+ push(@errors,
+ &mt("The error occurred on host [_1]",
+ "$host"));
+
+ my $msg = join('
', @errors);
+
#notify author
- &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('
',@_));
+ &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
#notify course
- if ( $symb && $ENV{'request.course.id'} ) {
- my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
- my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
+ if ( $symb && $env{'request.course.id'} ) {
+ my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ my (undef,%users)=&Apache::lonmsg::decide_receiver(undef,0,1,1,1);
+ my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
+ my $baseurl = &Apache::lonnet::clutter($declutter);
my @userlist;
foreach (keys %users) {
my ($user,$domain) = split(/:/, $_);
push(@userlist,"$user\@$domain");
- &Apache::lonmsg::user_normal_msg($user,$domain,
- "Error [$declutter]",join('
',@_));
+ my $key=$declutter.'_'.$user.'_'.$domain;
+ my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
+ [$key],
+ $cdom,$cnum);
+ my $now=time;
+ if ($now-$lastnotified{$key}>86400) {
+ my $title = &Apache::lonnet::gettitle($symb);
+ my $sentmessage;
+ &Apache::lonmsg::user_normal_msg($user,$domain,
+ "Error [$title]",$msg,'',$baseurl,'','',
+ \$sentmessage,$symb,$title,1);
+ &Apache::lonnet::put('nohist_xmlerrornotifications',
+ {$key => $now},
+ $cdom,$cnum);
+ }
}
- if ($ENV{'request.role.adv'}) {
- $errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
+ if ($env{'request.role.adv'}) {
+ $errormsg=&mt("An error occurred while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
} else {
- $errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");
+ $errormsg=&mt("An error occurred while processing this resource. The instructor has been notified.");
}
}
push(@Apache::lonxml::error_messages,"$errormsg
");
@@ -1479,21 +1911,22 @@ sub error {
sub warning {
$warningcount++;
- if ($ENV{'form.grade_target'} ne 'tex') {
+ if ($env{'form.grade_target'} ne 'tex') {
if ( &show_error_warn_msg() ) {
- my $request=$Apache::lonxml::request;
- if (!$request) { $request=Apache->request; }
push(@Apache::lonxml::warning_messages,
- $Apache::lonxml::warnings_error_header.
- "WARNING:".join('
',@_)."
\n");
+ $Apache::lonxml::warnings_error_header
+ .''
+ .&mt('[_1]W[_2]ARNING','','').": ".join('
',@_)
+ ."
\n"
+ );
$Apache::lonxml::warnings_error_header='';
}
}
}
sub info {
- if ($ENV{'form.grade_target'} ne 'tex'
- && $ENV{'request.state'} eq 'construct') {
+ if ($env{'form.grade_target'} ne 'tex'
+ && $env{'request.state'} eq 'construct') {
push(@Apache::lonxml::info_messages,join('
',@_)."
\n");
}
}
@@ -1525,14 +1958,14 @@ sub get_param {
}
if ( ! $args ) { return undef; }
if ( $case_insensitive ) {
- if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {
+ if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei) {
return &Apache::run::run("{$args;".'return $'.$param.'}',
$safeeval); #'
} else {
return undef;
}
} else {
- if ( $args =~ /my \$\Q$param\E=\"/ ) {
+ if ( $args =~ /my .*\$\Q$param\E[,\)]/ ) {
return &Apache::run::run("{$args;".'return $'.$param.'}',
$safeeval); #'
} else {
@@ -1551,10 +1984,10 @@ sub get_param_var {
}
&Apache::lonxml::debug("Args are $args param is $param");
if ($case_insensitive) {
- if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) {
+ if (! ($args=~s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei)) {
return undef;
}
- } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; }
+ } elsif ( $args !~ /my .*\$\Q$param\E[,\)]/ ) { return undef; }
my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
&Apache::lonxml::debug("first run is $value");
if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {
@@ -1570,113 +2003,144 @@ sub get_param_var {
}
}
-sub register_insert {
- my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');
- my $i;
- my $tagnum=0;
- my @order;
- for ($i=0;$i < $#data; $i++) {
- my $line = $data[$i];
- if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
- if ( $line =~ /TABLE/ ) { last; }
- my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);
- if ($tag) {
- $insertlist{"$tagnum.tag"} = $tag;
- $insertlist{"$tagnum.description"} = $descrip;
- $insertlist{"$tagnum.color"} = $color;
- $insertlist{"$tagnum.function"} = $function;
- if (!defined($show)) { $show='yes'; }
- $insertlist{"$tagnum.show"}= $show;
- $insertlist{"$tagnum.helpfile"} = $helpfile;
- $insertlist{"$tagnum.helpdesc"} = $helpdesc;
- $insertlist{"$tag.num"}=$tagnum;
- $tagnum++;
+sub register_insert_xml {
+ my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}
+ .'/insertlist.xml');
+ my ($tagnum,$in_help)=(0,0);
+ my @alltags;
+ my $tag;
+ while (my $token = $parser->get_token()) {
+ if ($token->[0] eq 'S') {
+ my $key;
+ if ($token->[1] eq 'tag') {
+ $tag = $token->[2]{'name'};
+ $insertlist{"$tagnum.tag"} = $tag;
+ $insertlist{"$tag.num"} = $tagnum;
+ push(@alltags,$tag);
+ } elsif ($in_help && $token->[1] eq 'file') {
+ $key = $tag.'.helpfile';
+ } elsif ($in_help && $token->[1] eq 'description') {
+ $key = $tag.'.helpdesc';
+ } elsif ($token->[1] eq 'description' ||
+ $token->[1] eq 'color' ||
+ $token->[1] eq 'show' ) {
+ $key = $tag.'.'.$token->[1];
+ } elsif ($token->[1] eq 'insert_sub') {
+ $key = $tag.'.function';
+ } elsif ($token->[1] eq 'help') {
+ $in_help=1;
+ } elsif ($token->[1] eq 'allow') {
+ $key = $tag.'.allow';
+ }
+ if (defined($key)) {
+ $insertlist{$key} = $parser->get_text();
+ $insertlist{$key} =~ s/(^\s*|\s*$ )//gx;
+ }
+ } elsif ($token->[0] eq 'E') {
+ if ($token->[1] eq 'tag') {
+ undef($tag);
+ $tagnum++;
+ } elsif ($token->[1] eq 'help') {
+ undef($in_help);
+ }
+ }
}
- }
- $i++; #skipping TABLE line
- $tagnum = 0;
- for (;$i < $#data;$i++) {
- my $line = $data[$i];
- my ($mnemonic,@which) = split(/ +/,$line);
- my $tag = $insertlist{"$tagnum.tag"};
- for (my $j=0;$j <=$#which;$j++) {
- if ( $which[$j] eq 'Y' ) {
- if ($insertlist{"$j.show"} ne 'no') {
- push(@{ $insertlist{"$tag.which"} },$j);
+
+ # parse the allows and ignore tags set to no
+ foreach my $tag (@alltags) {
+ next if (!exists($insertlist{"$tag.allow"}));
+ my $allow = $insertlist{"$tag.allow"};
+ foreach my $element (split(',',$allow)) {
+ $element =~ s/(^\s*|\s*$ )//gx;
+ if (!exists($insertlist{"$element.show"})
+ || $insertlist{"$element.show"} ne 'no') {
+ push(@{ $insertlist{$tag.'.which'} },$element);
+ }
}
- }
}
- $tagnum++;
- }
+}
+
+sub register_insert {
+ return ®ister_insert_xml(@_);
+# &dump_insertlist('2');
+}
+
+sub dump_insertlist {
+ my ($ext) = @_;
+ open(XML,">/tmp/insertlist.xml.$ext");
+ print XML ("");
+ my $i=0;
+
+ while (exists($insertlist{"$i.tag"})) {
+ my $tag = $insertlist{"$i.tag"};
+ print XML ("
+\t");
+ if (defined($insertlist{"$tag.description"})) {
+ print XML ("
+\t\t".$insertlist{"$tag.description"}."");
+ }
+ if (defined($insertlist{"$tag.color"})) {
+ print XML ("
+\t\t".$insertlist{"$tag.color"}."");
+ }
+ if (defined($insertlist{"$tag.function"})) {
+ print XML ("
+\t\t".$insertlist{"$tag.function"}."");
+ }
+ if (defined($insertlist{"$tag.show"})
+ && $insertlist{"$tag.show"} ne 'yes') {
+ print XML ("
+\t\t".$insertlist{"$tag.show"}."");
+ }
+ if (defined($insertlist{"$tag.helpfile"})) {
+ print XML ("
+\t\t
+\t\t\t".$insertlist{"$tag.helpfile"}."");
+ if ($insertlist{"$tag.helpdesc"} ne '') {
+ print XML ("
+\t\t\t".$insertlist{"$tag.helpdesc"}."");
+ }
+ print XML ("
+\t\t");
+ }
+ if (defined($insertlist{"$tag.which"})) {
+ print XML ("
+\t\t".join(',',sort(@{ $insertlist{"$tag.which"} }))."");
+ }
+ print XML ("
+\t");
+ $i++;
+ }
+ print XML ("\n\n");
+ close(XML);
}
sub description {
- my ($token)=@_;
- my $tagnum;
- my $tag=$token->[1];
- foreach my $namespace (reverse @Apache::lonxml::namespace) {
- my $testtag=$namespace.'::'.$tag;
- $tagnum=$insertlist{"$testtag.num"};
- if (defined($tagnum)) { last; }
- }
- if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
- return $insertlist{$tagnum.'.description'};
+ my ($token)=@_;
+ my $tag = &get_tag($token);
+ return $insertlist{$tag.'.description'};
}
# Returns a list containing the help file, and the description
sub helpinfo {
- my ($token)=@_;
- my $tagnum;
- my $tag=$token->[1];
- foreach my $namespace (reverse @Apache::lonxml::namespace) {
- my $testtag=$namespace.'::'.$tag;
- $tagnum=$insertlist{"$testtag.num"};
- if (defined($tagnum)) { last; }
- }
- if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
- return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'});
+ my ($token)=@_;
+ my $tag = &get_tag($token);
+ return ($insertlist{$tag.'.helpfile'}, $insertlist{$tag.'.helpdesc'});
}
-# ----------------------------------------------------------------- whichuser
-# returns a list of $symb, $courseid, $domain, $name that is correct for
-# calls to lonnet functions for this setup.
-# - looks for form.grade_ parameters
-sub whichuser {
- my ($passedsymb)=@_;
- my ($symb,$courseid,$domain,$name,$publicuser);
- if (defined($ENV{'form.grade_symb'})) {
- my ($tmp_courseid)=
- &Apache::loncommon::get_env_multiple('form.grade_courseid');
- my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
- if (!$allowed &&
- exists($ENV{'request.course.sec'}) &&
- $ENV{'request.course.sec'} !~ /^\s*$/) {
- $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid.
- '/'.$ENV{'request.course.sec'});
- }
- if ($allowed) {
- ($symb)=&Apache::loncommon::get_env_multiple('form.grade_symb');
- $courseid=$tmp_courseid;
- ($domain)=&Apache::loncommon::get_env_multiple('form.grade_domain');
- ($name)=&Apache::loncommon::get_env_multiple('form.grade_username');
- return ($symb,$courseid,$domain,$name,$publicuser);
- }
- }
- if (!$passedsymb) {
- $symb=&Apache::lonnet::symbread();
- } else {
- $symb=$passedsymb;
- }
- $courseid=$ENV{'request.course.id'};
- $domain=$ENV{'user.domain'};
- $name=$ENV{'user.name'};
- if ($name eq 'public' && $domain eq 'public') {
- if (!defined($ENV{'form.username'})) {
- $ENV{'form.username'}.=time.rand(10000000);
- }
- $name.=$ENV{'form.username'};
- }
- return ($symb,$courseid,$domain,$name,$publicuser);
+sub get_tag {
+ my ($token)=@_;
+ my $tagnum;
+ my $tag=$token->[1];
+ foreach my $namespace (reverse(@Apache::lonxml::namespace)) {
+ my $testtag = $namespace.'::'.$tag;
+ $tagnum = $insertlist{"$testtag.num"};
+ last if (defined($tagnum));
+ }
+ if (!defined($tagnum)) {
+ $tagnum = $Apache::lonxml::insertlist{"$tag.num"};
+ }
+ return $insertlist{"$tagnum.tag"};
}
1;