[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package DBI::Gofer::Response; 2 3 # $Id: Response.pm 11565 2008-07-22 20:17:33Z timbo $ 4 # 5 # Copyright (c) 2007, Tim Bunce, Ireland 6 # 7 # You may distribute under the terms of either the GNU General Public 8 # License or the Artistic License, as specified in the Perl README file. 9 10 use strict; 11 12 use Carp; 13 use DBI qw(neat neat_list); 14 15 use base qw(DBI::Util::_accessor Exporter); 16 17 our $VERSION = sprintf("0.%06d", q$Revision: 11565 $ =~ /(\d+)/o); 18 19 use constant GOf_RESPONSE_EXECUTED => 0x0001; 20 21 our @EXPORT = qw(GOf_RESPONSE_EXECUTED); 22 23 24 __PACKAGE__->mk_accessors(qw( 25 version 26 rv 27 err 28 errstr 29 state 30 flags 31 last_insert_id 32 dbh_attributes 33 sth_resultsets 34 warnings 35 )); 36 __PACKAGE__->mk_accessors_using(make_accessor_autoviv_hashref => qw( 37 meta 38 )); 39 40 41 sub new { 42 my ($self, $args) = @_; 43 $args->{version} ||= $VERSION; 44 chomp $args->{errstr} if $args->{errstr}; 45 return $self->SUPER::new($args); 46 } 47 48 49 sub err_errstr_state { 50 my $self = shift; 51 return @{$self}{qw(err errstr state)}; 52 } 53 54 sub executed_flag_set { 55 my $flags = shift->flags 56 or return 0; 57 return $flags & GOf_RESPONSE_EXECUTED; 58 } 59 60 61 sub add_err { 62 my ($self, $err, $errstr, $state, $trace) = @_; 63 64 # acts like the DBI's set_err method. 65 # this code copied from DBI::PurePerl's set_err method. 66 67 chomp $errstr if $errstr; 68 $state ||= ''; 69 carp ref($self)."->add_err($err, $errstr, $state)" 70 if $trace and defined($err) || $errstr; 71 72 my ($r_err, $r_errstr, $r_state) = ($self->{err}, $self->{errstr}, $self->{state}); 73 74 if ($r_errstr) { 75 $r_errstr .= sprintf " [err was %s now %s]", $r_err, $err 76 if $r_err && $err && $r_err ne $err; 77 $r_errstr .= sprintf " [state was %s now %s]", $r_state, $state 78 if $r_state and $r_state ne "S1000" && $state && $r_state ne $state; 79 $r_errstr .= "\n$errstr" if $r_errstr ne $errstr; 80 } 81 else { 82 $r_errstr = $errstr; 83 } 84 85 # assign if higher priority: err > "0" > "" > undef 86 my $err_changed; 87 if ($err # new error: so assign 88 or !defined $r_err # no existing warn/info: so assign 89 # new warn ("0" len 1) > info ("" len 0): so assign 90 or defined $err && length($err) > length($r_err) 91 ) { 92 $r_err = $err; 93 ++$err_changed; 94 } 95 96 $r_state = ($state eq "00000") ? "" : $state 97 if $state && $err_changed; 98 99 ($self->{err}, $self->{errstr}, $self->{state}) = ($r_err, $r_errstr, $r_state); 100 101 return undef; 102 } 103 104 105 sub summary_as_text { 106 my $self = shift; 107 my ($context) = @_; 108 109 my ($rv, $err, $errstr, $state) = ($self->{rv}, $self->{err}, $self->{errstr}, $self->{state}); 110 111 my @s = sprintf("\trv=%s", (ref $rv) ? "[".neat_list($rv)."]" : neat($rv)); 112 $s[-1] .= sprintf(", err=%s, errstr=%s", $err, neat($errstr)) 113 if defined $err; 114 $s[-1] .= sprintf(", flags=0x%x", $self->{flags}) 115 if defined $self->{flags}; 116 117 push @s, "last_insert_id=%s", $self->last_insert_id 118 if defined $self->last_insert_id; 119 120 if (my $dbh_attr = $self->dbh_attributes) { 121 my @keys = sort keys %$dbh_attr; 122 push @s, sprintf "dbh= { %s }", join(", ", map { "$_=>".neat($dbh_attr->{$_},100) } @keys) 123 if @keys; 124 } 125 126 for my $rs (@{$self->sth_resultsets || []}) { 127 my ($rowset, $err, $errstr, $state) 128 = @{$rs}{qw(rowset err errstr state)}; 129 my $summary = "rowset: "; 130 my $NUM_OF_FIELDS = $rs->{NUM_OF_FIELDS} || 0; 131 my $rows = $rowset ? @$rowset : 0; 132 if ($rowset || $NUM_OF_FIELDS > 0) { 133 $summary .= sprintf "%d rows, %d columns", $rows, $NUM_OF_FIELDS; 134 } 135 $summary .= sprintf ", err=%s, errstr=%s", $err, neat($errstr) if defined $err; 136 if ($rows) { 137 my $NAME = $rs->{NAME}; 138 # generate 139 my @colinfo = map { "$NAME->[$_]=".neat($rowset->[0][$_], 30) } 0..@{$NAME}-1; 140 $summary .= sprintf " [%s]", join ", ", @colinfo; 141 $summary .= ",..." if $rows > 1; 142 # we can be a little more helpful for Sybase/MSSQL user 143 $summary .= " syb_result_type=$rs->{syb_result_type}" 144 if $rs->{syb_result_type} and $rs->{syb_result_type} != 4040; 145 } 146 push @s, $summary; 147 } 148 for my $w (@{$self->warnings || []}) { 149 chomp $w; 150 push @s, "warning: $w"; 151 } 152 if ($context && %$context) { 153 my @keys = sort keys %$context; 154 push @s, join(", ", map { "$_=>".$context->{$_} } @keys); 155 } 156 return join("\n\t", @s). "\n"; 157 } 158 159 160 sub outline_as_text { # one-line version of summary_as_text 161 my $self = shift; 162 my ($context) = @_; 163 164 my ($rv, $err, $errstr, $state) = ($self->{rv}, $self->{err}, $self->{errstr}, $self->{state}); 165 166 my $s = sprintf("rv=%s", (ref $rv) ? "[".neat_list($rv)."]" : neat($rv)); 167 $s .= sprintf(", err=%s %s", $err, neat($errstr)) 168 if defined $err; 169 $s .= sprintf(", flags=0x%x", $self->{flags}) 170 if $self->{flags}; 171 172 if (my $sth_resultsets = $self->sth_resultsets) { 173 $s .= sprintf(", %d resultsets ", scalar @$sth_resultsets); 174 175 my @rs; 176 for my $rs (@{$self->sth_resultsets || []}) { 177 my $summary = ""; 178 my ($rowset, $err, $errstr) 179 = @{$rs}{qw(rowset err errstr)}; 180 my $NUM_OF_FIELDS = $rs->{NUM_OF_FIELDS} || 0; 181 my $rows = $rowset ? @$rowset : 0; 182 if ($rowset || $NUM_OF_FIELDS > 0) { 183 $summary .= sprintf "%dr x %dc", $rows, $NUM_OF_FIELDS; 184 } 185 $summary .= sprintf "%serr %s %s", ($summary?", ":""), $err, neat($errstr) 186 if defined $err; 187 push @rs, $summary; 188 } 189 $s .= join "; ", map { "[$_]" } @rs; 190 } 191 192 return $s; 193 } 194 195 196 1; 197 198 =head1 NAME 199 200 DBI::Gofer::Response - Encapsulate a response from DBI::Gofer::Execute to DBD::Gofer 201 202 =head1 DESCRIPTION 203 204 This is an internal class. 205 206 =head1 AUTHOR 207 208 Tim Bunce, L<http://www.tim.bunce.name> 209 210 =head1 LICENCE AND COPYRIGHT 211 212 Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved. 213 214 This module is free software; you can redistribute it and/or 215 modify it under the same terms as Perl itself. See L<perlartistic>. 216 217 =cut 218
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |