| … | |
… | |
| 687 | |
687 | |
| 688 | sub PG_warnings_handler { |
688 | sub PG_warnings_handler { |
| 689 | my @input = @_; |
689 | my @input = @_; |
| 690 | my $msg_string = longmess(@_); |
690 | my $msg_string = longmess(@_); |
| 691 | my @msg_array = split("\n",$msg_string); |
691 | my @msg_array = split("\n",$msg_string); |
|
|
692 | my $out_string = ''; |
|
|
693 | |
|
|
694 | # Extra stack information is provided in this next block |
|
|
695 | # If the warning message does NOT end in \n then a line |
|
|
696 | # number is appended (see Perl manual about warn function) |
|
|
697 | # The presence of the line number is detected below and extra |
|
|
698 | # stack information is added. |
|
|
699 | # To suppress the line number and the extra stack information |
|
|
700 | # add \n to the end of a warn message (in .pl files. In .pg |
|
|
701 | # files add ~~n instead |
|
|
702 | |
|
|
703 | if ($input[$#input]=~/line \d*\.\s*$/) { |
| 692 | my $out_string = "##More details:<BR>\n----"; |
704 | $out_string .= "##More details: <BR>\n----"; |
| 693 | foreach my $line (@msg_array) { |
705 | foreach my $line (@msg_array) { |
| 694 | chomp($line); |
706 | chomp($line); |
| 695 | next unless $line =~/\w+\:\:/; |
707 | next unless $line =~/\w+\:\:/; |
| 696 | $out_string .= "----" .$line . "<BR>\n"; |
708 | $out_string .= "----" .$line . "<BR>\n"; |
|
|
709 | } |
| 697 | } |
710 | } |
| 698 | |
711 | |
| 699 | $Global::WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string . |
712 | $Global::WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string . |
| 700 | "<BR>\n--------------------------------------<BR>\n<BR>\n"; |
713 | "<BR>\n--------------------------------------<BR>\n<BR>\n"; |
| 701 | $Global::background_plain_url = $Global::background_warn_url; |
714 | $Global::background_plain_url = $Global::background_warn_url; |