OpenInteract::Error::System - Catalog of system error handlers

 $R->throw( { code => 302, type => 'module' } );

package OpenInteract::Error::System;

# $Id: System.pm,v 1.9 2002/04/13 16:10:06 lachoy Exp $

use strict;
use Carp                   qw( cluck );
use Data::Dumper           qw( Dumper );
use OpenInteract::Error::Main;
use OpenInteract::Utility;
use SPOPS::Utility;

@OpenInteract::Error::System::ISA     = ();
$OpenInteract::Error::System::VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/);

my $ERROR_HOLD = $OpenInteract::Error::Main::ERROR_HOLD;

# Increment at which we should break down
# codes if not found (change to 100 for more macro)

my $CODE_SEEK = 10;

# Match up codes with the actual handler

$OpenInteract::Error::System::CODES = {
     '-1'  => \&log_and_return,
     '0'   => \&log_and_return,
     '10'  => \&cannot_parse_config,
     '11'  => \&cannot_connect_db,
     '100' => \&log_and_return,
     '200' => \&log_and_return,
     '201' => \&cannot_open_template,
     '202' => \&cannot_parse_template,
     '203' => \&cannot_send_mail,
     '204' => \&cannot_open_template_db,
     '205',=> \&cannot_find_login_fields,
     '300' => \&log_and_return,
     '301' => \&file_not_found,
     '302' => \&cannot_log_object_creation,
     '303' => \&task_is_forbidden,
     '304' => \&task_no_default,
     '305' => \&task_not_allowed_security,
     '307' => \&cannot_retrieve_object_of_id,
     '308' => \&log_and_return,
     '309' => \&log_and_return,
     '310' => \&cannot_create_session,
     '311' => \&log_and_return,
     '312' => \&log_and_return,
     '313' => \&log_and_return,
     '314' => \&file_not_found,
     '400' => \&log_and_return,
     '401' => \&bad_username,
     '402' => \&bad_password,
     '403' => \&cannot_fetch,
     '404' => \&cannot_fetch,
     '405' => \&log_and_return,
     '406' => \&log_and_return,
     '407' => \&log_and_return,
     '500' => \&log_and_return,
     '600' => \&log_and_return,
     '700' => \&log_and_return,
     '800' => \&log_and_return,
     '900' => \&log_and_return,
};

# Since we can handle any code, we move the checking phase to the error handler

sub can_handle_error {
    my ( $class, $err ) = @_;

    # Just find the general handler for that particular code. Here's an
    # example of how we find a code:
    # Original code: 512
    #  1) 512 -> not found -> 510
    #  2) 510 -> not found -> 500

    my $start = $CODE_SEEK;
    my $info = $OpenInteract::Error::System::CODES->{ $err->{code} };
    while ( ! $info ) {
        my $use_code = $err->{code} - ( $err->{code} % $start );
        $start *= 10;
        $info = $OpenInteract::Error::System::CODES->{ $use_code };
    }
    return $info;
}


#000

sub cannot_parse_config {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: Cannot open/parse config file.",
                       "$err->{tmp_filename} / $err->{system_msg}";
    $err->{notes} = "Filename tried to open: $err->{tmp_filename}";
    OpenInteract::Error::Main->save_error( $err );
    return '<h2 align="center">Website Down</h2>' .
           '<p>This website is currently down for technical reasons. Please come back shortly ' .
           'and we will surely have this configuration problem licked.';
}


# Since the db is down, we need to bypass the normal saving mechanisms
# and save the object by hand. We generate the ID here since it's
# normally done by the $err->save call.

sub cannot_connect_db {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG &&  cluck ">> Error: Cannot connect to db. Info:\n",
                        Dumper( $err->{tmp_db_info} ) ;
    my $C = $R->CONFIG;
    $err->{error_id} = SPOPS::Utility->generate_random_code( 16 );

    # First send an email

    my $msg = <<MSG;

Website Name: $C->{server_info}{website_name}

Something terrible has happened: I cannot connect to
the database or a previous connection has been dropped.
If you do not fix this soon, you will have an angry
mob of users on your hands.

 Error Code: $err->{error_id}
 (written out to $R->{dir}{base}/error)

Your friendly OpenInteract System
MSG
    my $send_to = $R->CONFIG->{mail}{admin_email} ||
                  $R->CONFIG->{admin_email};
    eval { OpenInteract::Utility->send_email({ to      => $send_to,
                                               message => $msg,
                                               subject => 'Cannot connect to database!' }) };
    if ( $@ ) {
        $err->{notes} = "Cannot send email to admin; saved email msg";
        $R->throw({ code => 203 });
    }
    else {
        $err->{notes} = 'E-mail sent to admin ok.';
    }
    $err->{notes} = "DB connection info:", Dumper( $err->{tmp_db_info} );
    $err->fail_save;
    return '<h2 align="center">Website Down</h2>' .
           '<p>This website is currently down for technical reasons. Please come back shortly ' .
           'and we will surely have this database problem licked.';
}


#100


#200

sub cannot_open_template {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: cannot open template.",
                       "$err->{tmp_filename} / $err->{system_msg}";
    $err->{user_msg} = 'Could not open template file';
    $err->{notes} = "Filename tried to open: $err->{tmp_filename}";
    OpenInteract::Error::Main->save_error( $err );
    return undef;
}


sub cannot_parse_template {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: cannot parse template.",
                       "$err->{tmp_filename} / $err->{system_msg}";
    $err->{user_msg} = 'Could not process template';
    $err->{notes} = "Filename tried to open: $err->{tmp_filename} (if blank, we used text passed in)";
    OpenInteract::Error::Main->save_error( $err );
    return "[[ error processing directive: template error ]]";
}


sub cannot_send_mail {
    my ( $err ) = @_;
    my $mail_info = $OpenInteract::Error::extra;
    OpenInteract::Error::Main->save_error( $err );
    my $R = OpenInteract::Request->instance;
    my $filename = $R->CONFIG->get_dir( 'mail' ) . "/msg_$err->{error_id}";
    eval { open( MAIL, "> $filename" ) || die $! };
    if ( $@ ) {
        $R->scrib( 0, "Good gravy! I cannot send an email, and I cannot open up a file to dump\n",
                      "the email into. (Tried: (($filename)) and got (($@)) in return.)\n",
                      "I'll just put it into STDERR and you can deal with it.\n\n", Dumper( $mail_info ), "\n" );
        return undef;
    }
    print MAIL "To: $mail_info->{to}\n",
               "From: $mail_info->{from}\n",
               "Subject: $mail_info->{subject}\n\n",
               $mail_info->{message}, "\n\n";
    close( MAIL );
    return undef;
}



sub cannot_open_template_db {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: cannot open template.",
                       "$err->{tmp_name} / $err->{system_msg}";
    $err->{user_msg} = 'Could not open template from database';
    $err->{notes} = "Tag tried to open with: $err->{tmp_name}";
    OpenInteract::Error::Main->save_error( $err );
    return undef;
}


sub cannot_find_login_fields {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: cannot find login/password fields!";
    $err->{user_msg}   = 'No login/password fields specified!';
    $err->{system_msg} = "Please create entries in your 'conf/server.perl' file under " .
                         "the 'login->login_field' and 'login->password_field' keys. I cannot " .
                         "process logins until this is done. Remember to restart the server after " .
                         "you have made the change.";
    OpenInteract::Error::Main->save_error( $err );
    return undef;
}


#300

# Syntax: $R->throw({ code => 314, system_msg => '/location/notfound' });

sub file_not_found {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: cannot find or open requested location *$err->{system_msg})";
    $err->{user_msg} = 'Requested file not found or cannot be opened';
    OpenInteract::Error::Main->save_error( $err );
    $R->{page}{title} = 'Sorry: Not found';
    my $html = $R->template->handler( {}, { err => $err },
                                      { name => 'error_not_found' } );
    die "$html\n";
}


sub cannot_log_object_creation {
    my ( $err ) = @_;
    OpenInteract::Error::Main->save_error( $err );
    return undef;
}


sub task_is_forbidden {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: Cannot perform task due to security ($err->{system_msg})";
    my $html = $R->template->handler( {},
                                      { err => $err,
                                        admin_email => $R->CONFIG->{mail}{admin_email} ||
                                                       $R->CONFIG->{admin_email} },
                                      { name => 'error_task_forbidden' } );
    die "$html\n";
}


sub task_no_default {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $err->{user_msg} = 'No default method defined';
    $R->DEBUG && cluck ">> Error: Cannot do task due to no default: $err->{system_msg}";

    # First send an email

    eval { OpenInteract::Utility->send_email({ to      => $err->{tmp_email},
                                               message => $err->{tmp_msg},
                                               subject => $err->{tmp_subject} }) };
    if ( $@ ) {
        $err->{notes} = "Cannot send email to author; saved email msg";
        $R->throw({ code => 203 });
    }
    else {
        $err->{notes} = 'E-mail sent to author ok.';
    }
    OpenInteract::Error::Main->save_error( $err );
    my $html = $R->template->handler( {},
                                      { err => $err,
                                        author_email => $err->{tmp_email} },
                                      { name => 'error_task_no_default' } );
    die "$html\n";
}


sub task_not_allowed_security {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: Cannot accomplish task due to security.";
    my $html = $R->template->handler( {},
                                      { err => $err,
                                        admin_email => $R->CONFIG->{mail}{admin_email} ||
                                                       $R->CONFIG->{admin_email}  },
                                      { name => 'error_task_forbidden' } );
    die "$html\n";
}


sub cannot_retrieve_object_of_id {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: Cannot retrieve object given a particular ID.";

    # First send an email

    my $msg = <<'';
For some reason beyond security, a user could not retrieve an object
given a particular ID. You might want to look into it.

    eval { OpenInteract::Utility->send_email({ to      => $R->CONFIG->{mail}{admin_email} || 
                                                          $R->CONFIG->{admin_email},
                                               message => $msg,
                                               subject => 'Failed to retrieve object' }) };
    if ( $@ ) {
        $err->{notes} = "Cannot send email to admin; saved email msg";
        $R->throw( { code => 203 } );
    }
    else {
        $err->{notes} = 'E-mail sent to admin ok.';
    }
    OpenInteract::Error::Main->save_error( $err );
    return undef;
}


sub cannot_create_session {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->scrib( 0, "Cannot create session -- someone is probably using a ",
                  "defunct key or something." );
    $R->cookies->create_cookie({
                   name => $OpenInteract::Session::COOKIE_NAME,
                   path => '/',
                   value => undef,
                   expires => '-3d' });
    return log_and_return( $err );
}


#400

sub bad_username {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: User $err->{tmp_login_name} not found in system";
    $R->{ $ERROR_HOLD }{loginbox}{bad_login} = "User $err->{tmp_login_name} not found!";
    return undef;
}

sub bad_password {
    my ( $err ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && cluck ">> Error: User $err->{tmp_login_name} login with wrong password";
    $R->{ $ERROR_HOLD }{loginbox}{bad_login}  = "Bad password for $err->{tmp_login_name}; try again.";
    $R->{ $ERROR_HOLD }{loginbox}{login_name} = $err->{tmp_login_name};
    return undef;
}


sub cannot_fetch {
    my ( $err ) = @_;
    if ( $err->{code} == 403 ) {
        cluck ">> Error thrown for not being able to fetch a group of objects. Msg: $err->{system_msg}";
    }
    elsif ( $err->{code} == 404 ) {
        cluck ">> Error thrown for not being able to fetch an object. Msg: $err->{system_msg}";
    }
    return log_and_return( $err, 'nowarn' );
}

#500


#600


#700



#Generic

sub log_and_return {
    my ( $err, $opt ) = @_;
    my $R = OpenInteract::Request->instance;
    cluck ">> Error with code $err->{code} thrown. Info: $err->{system_msg}" unless ( $opt eq 'nowarn' );
    $R->DEBUG && $R->scrib( 2, "Trying to save errror ", Dumper( $err ) );
    OpenInteract::Error::Main->save_error( $err );
    return undef;
}

1;

__END__