@ISA
=
qw(DBIx::ORM::Declarative::Table)
;
sub
_join_clause {
''
; }
sub
_isjoin { 1; }
sub
create
{
my
(
$self
,
%params
) =
@_
;
my
$handle
=
$self
->handle;
carp
"can't create without a database handle"
and
return
unless
$handle
;
my
$primary
=
$self
->_primary;
my
@table_info
=
$self
->_join_info;
my
$tab_obj
=
$self
->table(
$primary
);
my
(
$flag
) =
$self
->__check_constraints(
$tab_obj
,
%params
);
return
unless
$flag
;
my
%primary_map
=
$tab_obj
->_column_map;
my
@row_data
;
my
@backout_cmds
;
for
my
$tab
(
@table_info
)
{
my
$table
=
$tab
->{table};
$tab_obj
=
$self
->table(
$table
);
my
$tab_name
=
$tab_obj
->_sql_name;
my
%p
=
%params
;
$p
{
$tab
->{columns}{
$_
}} =
delete
$p
{
$_
}
foreach
grep
{
exists
$p
{
$_
} }
keys
%{
$tab
->{columns}};
for
my
$col
(
grep
{
$_
->{table} eq
$table
}
$self
->_columns)
{
my
$nm
=
$col
->{name};
my
$tab_alias
=
$col
->{table_alias};
next
if
length
(
$nm
)>
length
(
$tab_alias
)
and
$tab_alias
eq
substr
(
$nm
,
length
(
$tab_alias
));
my
$augmented_name
=
$tab_alias
.
'_'
.
$nm
;
$p
{
$nm
} =
$params
{
$augmented_name
}
if
exists
$params
{
$augmented_name
};
}
my
(
$flag
,
$keys
,
$values
,
$npk
,
@binds
)
=
$self
->__check_constraints(
$tab_obj
,
%p
);
if
(not
$flag
)
{
$self
->__do_rollback(
@backout_cmds
);
return
;
}
my
$sql
=
"INSERT INTO $tab_name ($keys) SELECT $values FROM DUAL"
;
my
%map
=
$tab_obj
->_column_map;
my
@pk
=
$tab_obj
->_primary_key;
my
@conditions
;
if
(
@pk
and not
$npk
)
{
my
@wk
;
for
my
$k
(
@pk
)
{
if
(
exists
$p
{
$k
})
{
push
@wk
,
$map
{
$k
} .
'=?'
;
push
@binds
,
$p
{
$k
};
}
}
if
(
@wk
)
{
push
@conditions
,
join
(
' AND '
,
@wk
);
}
}
my
@uniques
=
$tab_obj
->_unique_keys;
shift
@uniques
if
@pk
;
for
my
$un
(
@uniques
)
{
my
@wk
;
for
my
$k
(
@$un
)
{
if
(
exists
$p
{
$k
})
{
push
@wk
,
$map
{
$k
} .
'=?'
;
push
@binds
,
$p
{
$k
};
}
else
{
push
@wk
,
$map
{
$k
} .
' IS NULL'
;
}
}
push
@conditions
,
join
(
' AND '
,
@wk
)
if
@wk
;
}
if
(
@conditions
)
{
$sql
.=
" WHERE NOT EXISTS (SELECT 1 FROM $tab_name WHERE "
.
join
(
' OR '
,
map
{
"($_)"
}
@conditions
)
.
')'
;
}
unshift
@binds
,
undef
if
@binds
;
my
$dbres
=
$handle
->
do
(
$sql
,
@binds
);
if
(not
$dbres
)
{
carp
"Database error: "
.
$handle
->errstr;
$self
->__do_rollback(
@backout_cmds
);
return
;
}
if
(
$npk
)
{
my
$data
=
'never called'
;
if
(
$dbres
!= 0)
{
my
$np
=
$tab_obj
->_select_null_primary;
if
(
$np
)
{
$data
=
$handle
->selectall_arrayref(
$np
);
}
}
else
{
my
(
$ign
,
$un
) =
$tab_obj
->_unique_keys;
my
@cols
;
if
(
$un
)
{
@cols
=
@$un
;
}
else
{
@cols
=
grep
{
exists
$p
{
$_
} }
map
{
$_
->{name} }
$tab_obj
->_columns;
}
@binds
= ();
$sql
=
'SELECT '
.
join
(
','
,
map
{
$map
{
$_
} }
@pk
)
.
" FROM $tab_name WHERE "
;
my
@wk
;
push
@wk
,
$map
{
$_
} . (
defined
$p
{
$_
}?
'=?'
:
' IS NULL'
)
foreach
@cols
;
push
@binds
,
$p
{
$_
}
foreach
grep
{
defined
$p
{
$_
} }
@cols
;
$sql
.=
join
(
' AND '
,
@wk
);
unshift
@binds
,
undef
if
@binds
;
$data
=
$handle
->selectall_arrayref(
$sql
,
@binds
);
}
if
(not
$data
)
{
carp
"Database error: "
.
$handle
->errstr;
$self
->__do_rollback(
@backout_cmds
);
return
;
}
if
(
ref
$data
and not
defined
$data
->[0][0])
{
carp
"Database error: can't find primary key"
;
$self
->__do_rollback(
@backout_cmds
);
return
;
}
@p
{
@pk
} = @{
$data
->[0]}
if
ref
$data
;
}
if
(not
%p
)
{
carp
"Database error: no search parameters"
;
$self
->__do_rollback(
@backout_cmds
);
return
;
}
my
@cols
=
map
{
$_
->{name} }
$tab_obj
->_columns;
my
@wk
=
map
{
$map
{
$_
}
. ((
defined
$p
{
$_
})?(
'='
.
$handle
->quote(
$p
{
$_
})):(
' IS NULL'
)) }
grep
{
exists
$p
{
$_
} }
@cols
;
my
$table_name
=
$tab_obj
->_sql_name;
my
$wclause
=
" FROM $table_name WHERE "
.
join
(
' AND '
,
@wk
);
$sql
=
'SELECT '
.
join
(
','
,
map
{
$map
{
$_
} }
@cols
) .
$wclause
;
my
$data
=
$handle
->selectall_arrayref(
$sql
);
if
(not
$data
or not
$data
->[0])
{
carp
$self
->E_NOROWSOUND
if
$data
;
carp
'Database error: '
,
$handle
->errstr
unless
$data
;
$self
->__do_rollback(
@backout_cmds
);
return
;
}
if
(
@$data
> 1)
{
carp
$self
->E_TOOMANYROWS;
$self
->__do_rollback(
@backout_cmds
);
return
;
}
@p
{
@cols
} = @{
$data
->[0]};
$p
{
$_
} =
delete
$p
{
$tab
->{columns}{
$_
}}
foreach
grep
{
exists
$p
{
$tab
->{columns}{
$_
}} }
keys
%{
$tab
->{columns}};
$params
{
$_
} =
$p
{
$_
}
foreach
grep
{
exists
$p
{
$_
} }
keys
%{
$tab
->{columns}};
push
@row_data
, @{
$data
->[0]};
push
@backout_cmds
,
"DELETE $wclause"
;
}
my
(
$keys
,
$values
,
$npk
,
@binds
);
$tab_obj
=
$self
->table(
$primary
);
(
$flag
,
$keys
,
$values
,
$npk
,
@binds
) =
$self
->__check_constraints(
$tab_obj
,
%params
);
$self
->__do_rollback(
@backout_cmds
) and
return
unless
$flag
;
my
$table_name
=
$tab_obj
->_sql_name;
my
$sql
=
"INSERT INTO $table_name ($keys) VALUES ($values)"
;
unshift
@binds
,
undef
if
@binds
;
my
$dbres
=
$handle
->
do
(
$sql
,
@binds
);
if
(
$npk
)
{
my
@pk
=
$tab_obj
->_primary_key;
my
$np
=
$tab_obj
->_select_null_primary;
if
(
@pk
and
$np
)
{
my
$data
=
$handle
->selectall_arrayref(
$np
);
if
(not
$data
or not
defined
$data
->[0][0])
{
carp
$self
->E_NOROWSFOUND
if
$data
;
carp
"Database error: "
.
$handle
->errstr
unless
$data
;
$self
->__do_rollback(
@backout_cmds
);
return
;
}
@params
{
@pk
} = @{
$data
->[0]};
}
}
my
@search_params
=
map
{(
$_
, (
defined
$params
{
$_
}?(
eq
=>
$params
{
$_
}):(
'isnull'
)))}
grep
{
exists
$params
{
$_
} }
map
{
$_
->{name} }
$self
->_columns;
my
@res
=
$self
->search(\
@search_params
);
if
(not
@res
)
{
$self
->__do_rollback(
@backout_cmds
);
return
;
}
if
(
@res
>1)
{
carp
$self
->E_TOOMANYROWS;
$self
->__do_rollback;
return
;
}
local
(
$SIG
{__WARN__}) =
$self
->w__noop;
$handle
->commit;
return
$res
[0];
}
sub
no_can_do
{
my
(
$self
,
$method
) =
@_
;
carp
"Can't $method via a join - use the individual tables for that"
;
return
}
sub
delete
{
$_
[0]->no_can_do(
'delete'
); }
sub
bulk_create {
$_
[0]->no_can_do(
'bulk_create'
); }
sub
create_only {
$_
[0]->no_can_do(
'create_only'
); }
1;