has
'id'
=>
(
is
=>
'ro'
,
lazy_build
=> 1,
init_arg
=>
undef
,
);
has
[
qw( source_columns target_columns )
] =>
(
is
=>
'ro'
,
isa
=>
'Fey.Type.ArrayRefOfColumns'
,
required
=> 1,
coerce
=> 1,
);
has
[
qw( source_table target_table )
] =>
(
is
=>
'ro'
,
does
=>
'Fey::Role::TableLike'
,
lazy_build
=> 1,
init_arg
=>
undef
,
);
has
column_pairs
=>
(
is
=>
'ro'
,
isa
=>
'ArrayRef[ArrayRef[Fey::Column]]'
,
lazy_build
=> 1,
init_arg
=>
undef
,
);
has
is_self_referential
=>
(
is
=>
'ro'
,
isa
=>
'Bool'
,
lazy_build
=> 1,
init_arg
=> 1,
);
sub
BUILD
{
my
$self
=
shift
;
my
$p
=
shift
;
my
@source
= @{
$self
->source_columns() };
my
@target
= @{
$self
->target_columns() };
unless
(
@source
==
@target
)
{
param_error
(
"The source and target arrays passed to add_foreign_key()"
.
" must contain the same number of columns."
);
}
if
(
grep
{ !
$_
->table() }
@source
,
@target
)
{
param_error
"All columns passed to add_foreign_key() must have a table."
;
}
for
my
$p
( [
source
=> \
@source
], [
target
=> \
@target
] )
{
my
(
$name
,
$array
) = @{
$p
};
if
( uniq(
map
{
$_
->table() } @{
$array
} ) > 1 )
{
param_error
(
"Each column in the $name argument to add_foreign_key()"
.
" must come from the same table."
);
}
}
return
}
sub
_build_id
{
my
$self
=
shift
;
return
join
"\0"
,
(
sort
map
{
$_
->table()->name() .
q{.}
.
$_
->name() }
@{
$self
->source_columns() }, @{
$self
->target_columns() }
);
}
sub
_build_column_pairs
{
my
$self
=
shift
;
my
@s
= @{
$self
->source_columns() };
my
@t
= @{
$self
->target_columns() };
return
[ pairwise { [
$a
,
$b
] }
@s
,
@t
];
}
sub
_build_source_table
{
my
$self
=
shift
;
return
$self
->source_columns()->[0]->table();
}
sub
_build_target_table
{
my
$self
=
shift
;
return
$self
->target_columns()->[0]->table();
}
sub
has_tables
{
my
$self
=
shift
;
my
(
$table1
,
$table2
) =
pos_validated_list( \
@_
,
{
isa
=>
'Fey.Type.TableOrName'
},
{
isa
=>
'Fey.Type.TableOrName'
},
);
my
$name1
= blessed
$table1
?
$table1
->name() :
$table1
;
my
$name2
= blessed
$table2
?
$table2
->name() :
$table2
;
my
@looking_for
=
sort
$name1
,
$name2
;
my
@have
=
sort
map
{
$_
->name() }
$self
->source_table(),
$self
->target_table();
return
(
$looking_for
[0] eq
$have
[0]
&&
$looking_for
[1] eq
$have
[1] );
}
sub
has_column
{
my
$self
=
shift
;
my
(
$col
) = pos_validated_list( \
@_
, {
isa
=>
'Fey::Column'
} );
my
$table_name
=
$col
->table()->name();
my
@cols
;
for
my
$part
(
qw( source target )
)
{
my
$table_meth
=
$part
.
'_table'
;
if
(
$self
->
$table_meth
()->name() eq
$table_name
)
{
my
$col_meth
=
$part
.
'_columns'
;
@cols
= @{
$self
->
$col_meth
() };
}
}
return
0
unless
@cols
;
my
$col_name
=
$col
->name();
return
1
if
grep
{
$_
->name() eq
$col_name
}
@cols
;
return
0;
}
sub
_build_is_self_referential
{
my
$self
=
shift
;
return
$self
->source_table()->name() eq
$self
->target_table()->name();
}
sub
pretty_print
{
my
$self
=
shift
;
my
@source_columns
= @{
$self
->source_columns() };
my
@target_columns
= @{
$self
->target_columns() };
my
$longest
=
max
map
{
length
$_
->name() }
$self
->source_table(),
$self
->target_table(),
@source_columns
,
@target_columns
;
$longest
+= 2;
my
$string
=
sprintf
(
"\%-${longest}s \%-${longest}s\n"
,
$self
->source_table()->name(),
$self
->target_table()->name(),
);
$string
.= (
'-'
) x
$longest
;
$string
.=
q{ }
;
$string
.= (
'-'
) x
$longest
;
$string
.=
"\n"
;
$string
.=
(
join
''
, pairwise {
sprintf
(
"\%-${longest}s \%-${longest}s\n"
,
$a
->name(),
$b
->name() ) }
@source_columns
,
@target_columns
);
return
$string
;
}
no
Moose;
no
Moose::Util::TypeConstraints;
__PACKAGE__->meta()->make_immutable();
1;