1# -*-perl-*- 2 3# $Id: 05_exception.t,v 3.1 2003/02/16 22:01:56 lachoy Exp $ 4 5use strict; 6use Test::More tests => 58; 7 8# Test normal base exception 9 10{ 11 require_ok( 'SPOPS::Exception' ); 12 my $e_message = 'Error fetching object'; 13 eval { SPOPS::Exception->throw( $e_message ) }; 14 my $e = $@; 15 is( ref $e, 'SPOPS::Exception', 'Object creation' ); 16 is( $e->message(), $e_message, 'Message creation' ); 17 ok( $e->package(), 'Package set' ); 18 ok( $e->filename(), 'Filename set' ); 19 ok( $e->line(), 'Line number set' ); 20 ok( $e->method(), 'Method set' ); 21 is( ref( $e->trace() ), 'Devel::StackTrace', 'Trace set' ); 22 is( "$e", $e_message, '$@ stringified' ); 23 my @stack = $e->get_stack(); 24 is( scalar @stack, 1, 'Stack set' ); 25} 26 27# Test the security exception 28 29{ 30 require_ok( 'SPOPS::Exception::Security' ); 31 my $s_message = 'Security restrictions violated'; 32 eval { SPOPS::Exception::Security->throw( $s_message ) }; 33 my $s = $@; 34 is( ref $s, 'SPOPS::Exception::Security', 'Security object creation' ); 35 is( $s->message(), $s_message, 'Security message creation' ); 36 ok( $s->package(), 'Security package set' ); 37 ok( $s->filename(), 'Security filename set' ); 38 ok( $s->line(), 'Security line number set' ); 39 ok( $s->method(), 'Security method set' ); 40 $s->security_required( 4 ); 41 $s->security_found( 1 ); 42 is( $s->security_required(), 4, 'Security required set' ); 43 is( $s->security_found(), 1, 'Security found set' ); 44 is( ref( $s->trace() ), 'Devel::StackTrace', 'Trace set' ); 45 my $stringified = "Security violation. Object requested [READ] and got [NONE]"; 46 is( "$s", $stringified, 'Security $@ stringified' ); 47 my @stack = $s->get_stack(); 48 is( scalar @stack, 2, 'Stack set' ); 49} 50 51# Test the DBI exception 52 53{ 54 require_ok( 'SPOPS::Exception::DBI' ); 55 my $d_message = 'INSERT failed: Mismatch between number of fields and values'; 56 my $action = 'insert'; 57 my $sql = 'INSERT INTO blah ( f1, f2 ) VALUES ( 5, ?, ? )'; 58 my $bound = [ 'Adam', 'Eve' ]; 59 60 eval { SPOPS::Exception::DBI->throw( $d_message ) }; 61 my $d = $@; 62 is( ref $d, 'SPOPS::Exception::DBI', 'DBI object creation' ); 63 is( $d->message(), $d_message, 'DBI message creation' ); 64 ok( $d->package(), 'DBI package set' ); 65 ok( $d->filename(), 'DBI filename set' ); 66 ok( $d->line(), 'DBI line number set' ); 67 ok( $d->method(), 'DBI method set' ); 68 $d->action( $action ); 69 $d->sql( $sql ); 70 $d->bound_value( $bound ); 71 is( $d->action(), $action, 'DBI action set' ); 72 is( $d->sql(), $sql, 'DBI SQL string set' ); 73 is( $d->bound_value()->[0], $bound->[0], 'DBI bound value 1 set' ); 74 is( $d->bound_value()->[1], $bound->[1], 'DBI bound value 2 set' ); 75 is( ref( $d->trace() ), 'Devel::StackTrace', 'Trace set' ); 76 is( "$d", join( "\n", $d_message, $sql ), 'DBI $@ stringified' ); 77 my @stack = $d->get_stack(); 78 is( scalar @stack, 3, 'Stack set' ); 79} 80 81# Test the LDAP exception 82 83{ 84 require_ok( 'SPOPS::Exception::LDAP' ); 85 my $l_message = 'Invalid filter: objectclorss not known in schema'; 86 my $code = 123; 87 my $action = 'insert'; 88 my $filter = '(objectclorss=inetOrgPerson)'; 89 my $error_name = 'test'; 90 eval { SPOPS::Exception::LDAP->throw( $l_message ) }; 91 my $l = $@; 92 is( ref $l, 'SPOPS::Exception::LDAP', 'LDAP object creation' ); 93 is( $l->message(), $l_message, 'LDAP message creation' ); 94 ok( $l->package(), 'LDAP package set' ); 95 ok( $l->filename(), 'LDAP filename set' ); 96 ok( $l->line(), 'LDAP line number set' ); 97 ok( $l->method(), 'LDAP method set' ); 98 $l->code( $code ); 99 $l->action( $action ); 100 $l->filter( $filter ); 101 $l->error_name( $error_name ); 102 $l->error_text( $l_message ); 103 is( $l->code(), $code, 'LDAP error code set' ); 104 is( $l->action(), $action, 'LDAP action set' ); 105 is( $l->filter(), $filter, 'LDAP filter set' ); 106 is( $l->error_name(), $error_name, 'LDAP error name set' ); 107 is( $l->error_text(), $l_message, 'LDAP error text set' ); 108 is( ref( $l->trace() ), 'Devel::StackTrace', 'Trace set' ); 109 is( "$l", $l_message, 'LDAP $@ stringified' ); 110 my @stack = $l->get_stack(); 111 is( scalar @stack, 4, 'Stack set' ); 112} 113 114# Test backward compatibility with SPOPS::Error 115 116{ 117 require_ok( 'SPOPS::Error' ); 118 my $e_message = 'Error fetching object'; 119 eval { SPOPS::Exception->throw( $e_message ) }; 120 my $e = $@; 121 my $error_info = SPOPS::Error->get; 122 is( $e->message(), $error_info->{user_msg}, 'Compatibility: user_msg' ); 123 is( $e->message(), $error_info->{system_msg}, 'Compatibility: system_msg' ); 124 is( $e->package(), $error_info->{package}, 'Compatibility: package' ); 125 is( $e->filename(), $error_info->{filename}, 'Compatibility: filename' ); 126 is( $e->line(), $error_info->{line}, 'Compatibility: line' ); 127 is( $e->method(), $error_info->{method}, 'Compatibility: method' ); 128 } 129