Merge pull request #5230 from solgenomics/topic/open_pollinated
[sgn.git] / cgi-bin / solpeople / admin / crash_test.pl
blob2371c373463d56654611f33b882f6520278cf648
1 #!/usr/bin/perl -w
3 use strict;
4 use CXGN::DB::Connection;
5 use CXGN::Page;
6 use CXGN::Login;
7 use CXGN::Contact;
8 use CXGN::People;
9 use CatalystX::GlobalContext qw( $c );
11 my $page = CXGN::Page->new("crash_test.pl","john binns");
12 my $dbh = CXGN::DB::Connection->new();
14 # We are NOT using get_encoded_arguments here because we want to
15 # simulate scripts that have neglected this.
16 my($test,$message) = $page->get_arguments('test','message');
17 $message ||= 'crash_test';
19 my $is_production_server = $c->config->{'production_server'};
20 my $logged_in_person_id = CXGN::Login->new($dbh)->verify_session();
21 my $logged_in_user = CXGN::People::Person->new($dbh, $logged_in_person_id);
22 my $logged_in_username = $logged_in_user->get_first_name()." ".$logged_in_user->get_last_name();
23 my $logged_in_user_type=$logged_in_user->get_user_type();
25 if( !$is_production_server || $logged_in_user_type eq 'curator') {
26 if ($test) {
27 # Demonstrate the ugly double header problem, in case someone
28 # tries to fix it sometime.
29 $page->header('Crash tester');
30 if ($test == 1) {
31 $page->error_page($message,'message body','errorverbed','developer message');
32 } elsif ($test == 2) {
33 &rube_goldberg(); #unneccessary function to test stack backtrace
34 } elsif ($test == 3) {
35 eval {
36 die("Well, don't REALLY die.");
38 if ($@) {
39 print $@;
40 } else {
41 print"Code eval'd without errors.";
43 } elsif ($test == 4) {
44 $page->message_page($message,'message body');
45 } elsif ($test == 5) {
46 $c->forward_to_mason_view('/test/error_test.mas');
47 } elsif ($test == 6) {
48 $c->render_mason('/test/error_test.mas');
49 } else {
50 $page->message_page('Deeerrrrrrrr....');
52 $page->footer();
53 } else { #no arguments
54 &plain_page($page, $message);
57 else {
58 $page->message_page('Sorry, but you are not authorized to run crash tests.');
61 sub rube_goldberg {
62 die 'big ugly terrible death';
65 sub plain_page {
66 my $page = shift;
67 my $message = shift;
68 $page->header();
69 print <<EOF;
70 <a href="?test=1&amp;message=$message">Test anticipated error</a>
71 (Note: the notion of &quot;anticipated&quot; error is deprecated.
72 Just call die().)
73 <br /><br />
75 <a href="?test=2">Test unanticipated error</a>
76 (Note: the notion of &quot;unanticipated&quot; error is deprecated.
77 Just call die().)
78 <br /><br />
80 <a href="?test=5">Test Mason-handled error 1</a>
81 <br /><br />
82 <a href="?test=6">Test Mason-handled error 2</a>
83 <br /><br />
85 <a href="page_that_doesnt_compile.pl">Test compile-time error</a>
86 (Actually, this page does compile, and the error has always been a
87 run-time error.)
88 <br /><br />
90 <a href="another_page_that_doesnt_compile.pl">
91 Test an actual compile-time error</a>
92 (Specifically, an execution error during compilation.)
93 <br /><br />
95 <a href="page_with_syntax_error.pl">Test a syntax error</a>
96 (Specifically a parse error, which Perl seems to handle differently
97 than execution errors during compilation)
98 <br /><br />
100 <a href="/page_that_doesnt_exist/">Test 404</a><br /><br />
102 <a href="image_404_test.pl">Test image 404 within a page</a><br /><br />
104 <a href="?test=4&amp;message=$message">Test message page</a><br /><br />
106 <a href="?test=3">Test eval (page should NOT generate error page, just a long message)</a><br /><br />
109 $page->footer();
110 exit(0);