need to clean
+ # up if it did
+ &Apache::structuretags::reset_problem_globals();
+ &Apache::lonhomework::finished_parsing();
+ } elsif ($filetype eq 'tex') {
+ $result = &Apache::lontexconvert::converted(\$filecontents,
+ $env{'form.texengine'});
+ if ($env{'form.return_only_error_and_warning_counts'}) {
+ $result = "$errorcount:$warningcount";
+ }
+ } else {
+ $result = $filecontents;
+ }
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['rawmode']);
+ if ($env{'form.rawmode'}) { $result = $filecontents; }
+ if (($filetype ne 'html') &&
+ (!$env{'form.return_only_error_and_warning_counts'})) {
+ my $nochgview = 1;
+ my $controls = '';
+ if ($env{'request.state'} eq 'construct') {
+ $controls = &Apache::loncommon::head_subbox(
+ &Apache::loncommon::CSTR_pageheader()
+ .&Apache::londefdef::edit_controls($nochgview));
+ }
+ if ($filetype ne 'sty' && $filetype ne 'tex') {
+ $result =~ s/</g;
+ $result =~ s/>/>/g;
+ $result = '';
+ }
+ if ($env{'environment.remote'} eq 'off') {
+ my $brcrum;
+ if ($env{'request.state'} eq 'construct') {
+ $brcrum = [{'href' => &Apache::loncommon::authorspace(),
+ 'text' => 'Construction Space'},
+ {'href' => '',
+ 'text' => $breadcrumbtext}];
+ } else {
+ $brcrum = ''; # FIXME: Where are we?
+ }
+ my %options = ('bread_crumbs' => $brcrum,
+ 'bgcolor' => '#FFFFFF');
+ $result =
+ &Apache::loncommon::start_page(undef,undef,\%options)
+ .$controls
+ .$result
+ .&Apache::loncommon::end_page();
+ } else {
+ $result = $controls.$result;
+ }
+ }
+ }
+ }
+
+#
+# Edit action? Insert editing commands
+#
+ unless ($env{'request.state'} eq 'published') {
+ if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
+ {
+ my $displayfile=$request->uri;
+ $displayfile=~s/^\/[^\/]*//;
+
+ 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, });
+ my $header;
+ if ($env{'request.state'} eq 'construct') {
+ $options{'bread_crumbs'} = [{
+ 'href' => &Apache::loncommon::authorspace(),
+ 'text' => 'Construction Space'},
+ {'href' => '',
+ 'text' => $breadcrumbtext}];
+ $header = &Apache::loncommon::head_subbox(
+ &Apache::loncommon::CSTR_pageheader());
+ }
+ if ($env{'environment.remote'} ne 'off') {
+ $options{'bgcolor'} = '#FFFFFF';
+ $options{'only_body'} = 1;
+ }
+ 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
+ .$header
+ .&Apache::lonxml::message_location()
+ .$edit_info
+ .&Apache::loncommon::end_page();
+ }
+ }
+ if ($filetype eq 'html') { &writeallows($request->uri); }
+
+ &Apache::lonxml::add_messages(\$result);
+ $request->print($result);
+
+ return OK;
}
-
+
+sub display_title {
+ my $result;
+ if ($env{'request.state'} eq 'construct') {
+ my $title=&Apache::lonnet::gettitle();
+ if (!defined($title) || $title eq '') {
+ $title = $env{'request.filename'};
+ $title = substr($title, rindex($title, '/') + 1);
+ }
+ $result = "";
+ }
+ return $result;
+}
+
sub debug {
- if ($Apache::lonxml::debug eq 1) {
- print "DEBUG:".$_[0]."
\n";
- }
+ if ($Apache::lonxml::debug eq "1") {
+ $|=1;
+ my $request=$Apache::lonxml::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'})) {
+ return 1;
+ }
+ return (($Apache::lonxml::debug eq 1) ||
+ ($env{'request.state'} eq 'construct') ||
+ ($Apache::lonhomework::browse eq 'F'
+ &&
+ $env{'form.show_errors'} eq 'on'));
}
sub error {
- if ($Apache::lonxml::debug eq 1) {
- print "ERROR:".$_[0]."
\n";
- } else {
- print "An Error occured while processing this resource. The instructor has been notified.
";
- #notify author
- &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);
- #notify course
- if ( $ENV{'request.course.id'} ) {
- my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
- foreach my $user (split /\,/, $users) {
- ($user,my $domain) = split /:/, $user;
- &Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
- }
+ 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
+ .''
+ .''.&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 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'},$msg);
+ #notify course
+ 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");
+ 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 occurred while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
+ } else {
+ $errormsg=&mt("An error occurred while processing this resource. The instructor has been notified.");
+ }
+ }
+ push(@Apache::lonxml::error_messages,"$errormsg
");
}
-
- #FIXME probably shouldn't have me get everything forever.
- &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);
- #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
- }
}
sub warning {
- if ($ENV{'request.state'} eq 'construct') {
- print "WARNING:".$_[0]."
\n";
+ $warningcount++;
+
+ if ($env{'form.grade_target'} ne 'tex') {
+ if ( &show_error_warn_msg() ) {
+ push(@Apache::lonxml::warning_messages,
+ $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') {
+ push(@Apache::lonxml::info_messages,join('
',@_)."
\n");
+ }
+}
+
+sub message_location {
+ return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__';
+}
+
+sub add_messages {
+ my ($msg)=@_;
+ my $result=join(' ',
+ @Apache::lonxml::info_messages,
+ @Apache::lonxml::error_messages,
+ @Apache::lonxml::warning_messages);
+ undef(@Apache::lonxml::info_messages);
+ undef(@Apache::lonxml::error_messages);
+ undef(@Apache::lonxml::warning_messages);
+ $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__/$result/;
+ $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__//g;
+}
+
+sub get_param {
+ my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
+ if ( ! $context ) { $context = -1; }
+ my $args ='';
+ if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
+ if ( ! $Apache::lonxml::usestyle ) {
+ $args=$Apache::lonxml::style_values.$args;
+ }
+ if ( ! $args ) { return undef; }
+ if ( $case_insensitive ) {
+ 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[,\)]/ ) {
+ return &Apache::run::run("{$args;".'return $'.$param.'}',
+ $safeeval); #'
+ } else {
+ return undef;
+ }
+ }
+}
+
+sub get_param_var {
+ my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
+ if ( ! $context ) { $context = -1; }
+ my $args ='';
+ if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
+ if ( ! $Apache::lonxml::usestyle ) {
+ $args=$Apache::lonxml::style_values.$args;
+ }
+ &Apache::lonxml::debug("Args are $args param is $param");
+ if ($case_insensitive) {
+ if (! ($args=~s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei)) {
+ 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*$/) {
+ &Apache::lonxml::debug("doing second");
+ my @result=&Apache::run::run("return $value",$safeeval,1);
+ if (!defined($result[0])) {
+ return $value
+ } else {
+ if (wantarray) { return @result; } else { return $result[0]; }
+ }
+ } else {
+ return $value;
}
}
+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'};
+ if (defined($tag)) {
+ $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);
+ }
+ }
+ }
+
+ # 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);
+ }
+ }
+ }
+}
+
+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 $tag = &get_tag($token);
+ return $insertlist{$tag.'.description'};
+}
+
+# Returns a list containing the help file, and the description
+sub helpinfo {
+ my ($token)=@_;
+ my $tag = &get_tag($token);
+ return ($insertlist{$tag.'.helpfile'}, $insertlist{$tag.'.helpdesc'});
+}
+
+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"};
+}
+
+############################################################
+# PDF-FORM-METHODS
+
+=pod
+
+=item &print_pdf_radiobutton(fieldname, value)
+
+Returns a latexline to generate a PDF-Form-Radiobutton.
+Note: Radiobuttons with equal names are automaticly grouped
+ in a selection-group.
+
+$fieldname: PDF internalname of the radiobutton(group)
+$value: Value of radiobutton
+
+=cut
+sub print_pdf_radiobutton {
+ my ($fieldname, $value) = @_;
+ return '\radioButton[\symbolchoice{circle}]{'
+ .$fieldname.'}{10bp}{10bp}{'.$value.'}';
+}
+
+
+=pod
+
+=item &print_pdf_start_combobox(fieldname)
+
+Starts a latexline to generate a PDF-Form-Combobox with text.
+
+$fieldname: PDF internal name of the Combobox
+
+=cut
+sub print_pdf_start_combobox {
+ my $result;
+ my ($fieldName) = @_;
+ $result .= '\begin{tabularx}{\textwidth}{p{2.5cm}X}'."\n";
+ $result .= '\comboBox[]{'.$fieldName.'}{2.3cm}{14bp}{'; #
+
+ return $result;
+}
+
+
+=pod
+
+=item &print_pdf_add_combobox_option(options)
+
+Generates a latexline to add Options to a PDF-Form-ComboBox.
+
+$option: PDF internal name of the Combobox-Option
+
+=cut
+sub print_pdf_add_combobox_option {
+
+ my $result;
+ my ($option) = @_;
+
+ $result .= '('.$option.')';
+
+ return $result;
+}
+
+
+=pod
+
+=item &print_pdf_end_combobox(text) {
+
+Returns latexcode to end a PDF-Form-Combobox with text.
+
+=cut
+sub print_pdf_end_combobox {
+ my $result;
+ my ($text) = @_;
+
+ $result .= '}&'.$text."\\\\\n";
+ $result .= '\end{tabularx}' . "\n";
+ $result .= '\hspace{2mm}' . "\n";
+ return $result;
+}
+
+
+=pod
+
+=item &print_pdf_hiddenField(fieldname, user, domain)
+
+Returns a latexline to generate a PDF-Form-hiddenField with userdata.
+
+$fieldname label for hiddentextfield
+$user: name of user
+$domain: domain of user
+
+=cut
+sub print_pdf_hiddenfield {
+ my $result;
+ my ($fieldname, $user, $domain) = @_;
+
+ $result .= '\textField [\F{\FHidden}\F{-\FPrint}\V{'.$domain.'&'.$user.'}]{'.$fieldname.'}{0in}{0in}'."\n";
+
+ return $result;
+}
+
1;
__END__
-
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.