use
5.010_001;
package
DBIx::Squirrel::ResultClass;
BEGIN {
$DBIx::Squirrel::ResultClass::VERSION
=
$DBIx::Squirrel::VERSION
;
}
use
constant
E_BAD_OBJECT
=>
'A reference to either an array or hash was expected'
;
use
constant
E_STH_EXPIRED
=>
'Result is no longer associated with a statement'
;
use
constant
E_UNKNOWN_COLUMN
=>
'Unrecognised column (%s)'
;
sub
new {
my
$class
=
ref
(
$_
[0]) ?
ref
(
shift
) :
shift
;
return
ref
(
$_
[0]) ?
bless
(
shift
,
$class
) :
shift
;
}
sub
result_class {
return
shift
->results->result_class;
}
BEGIN {
*row_base_class
=
*result_class
;
}
sub
row_class {
return
shift
->results->row_class;
}
sub
get_column {
local
(
$_
);
my
(
$self
,
$name
) =
@_
;
return
unless
defined
(
$name
);
if
(UNIVERSAL::isa(
$self
,
'ARRAY'
)) {
throw E_STH_EXPIRED
unless
my
$sth
=
$self
->rs->sth;
my
$n
=
$sth
->{NAME_lc_hash}{
lc
(
$name
)};
throw E_UNKNOWN_COLUMN,
$name
unless
defined
(
$n
);
return
$self
->[
$n
];
}
else
{
throw E_BAD_OBJECT
unless
UNIVERSAL::isa(
$self
,
'HASH'
);
return
$self
->{
$name
}
if
exists
(
$self
->{
$name
});
local
(
$_
);
my
(
$n
) =
grep
{
lc
eq
$_
[1]}
keys
(%{
$self
});
throw E_UNKNOWN_COLUMN,
$name
unless
defined
(
$n
);
return
$self
->{
$n
};
}
}
our
$AUTOLOAD
;
sub
AUTOLOAD {
local
(
$_
);
no
strict
'refs'
;
return
if
substr
(
$AUTOLOAD
, -7) eq
'DESTROY'
;
my
$name
=
$AUTOLOAD
;
$name
=~ s/.*:://;
my
(
$self
) =
@_
;
my
$symbol
=
$self
->row_class .
'::'
.
$name
;
my
$accessor
=
do
{
push
@{
$self
->row_class .
'::AUTOLOAD_ACCESSORS'
},
$symbol
;
if
(UNIVERSAL::isa(
$self
,
'ARRAY'
)) {
throw E_STH_EXPIRED
unless
my
$sth
=
$self
->rs->sth;
my
$n
=
$sth
->{NAME_lc_hash}{
lc
(
$name
)};
throw E_UNKNOWN_COLUMN,
$name
unless
defined
(
$n
);
sub
{
$_
[0][
$n
]};
}
elsif
(UNIVERSAL::isa(
$self
,
'HASH'
)) {
if
(
exists
(
$self
->{
$name
})) {
sub
{
$_
[0]{
$name
}};
}
else
{
local
(
$_
);
my
(
$n
) =
grep
{
lc
eq
$name
}
keys
(%{
$self
});
throw E_UNKNOWN_COLUMN,
$name
unless
defined
(
$n
);
sub
{
$_
[0]{
$n
}};
}
}
else
{
throw E_BAD_OBJECT;
}
};
*{
$symbol
} = subname(
$symbol
=>
$accessor
);
goto
&{
$symbol
};
}
1;