our
@ISA
=
qw(Rose::DB::Object::Metadata::Auto)
;
our
$VERSION
=
'0.784'
;
sub
auto_generate_columns
{
my
(
$self
) =
shift
;
my
(
$class
,
%columns
,
$error
);
TRY:
{
local
$@;
eval
{
my
$col_info
= (
$self
->_table_info)[0] || [];
die
"No columns found"
unless
(
@$col_info
);
my
$db
=
$self
->db;
my
$dbh
=
$db
->dbh or
die
$db
->error;
foreach
my
$info
(
@$col_info
)
{
$db
->refine_dbi_column_info(
$info
);
$columns
{
$info
->{
'COLUMN_NAME'
}} =
$self
->auto_generate_column(
$info
->{
'COLUMN_NAME'
},
$info
);
}
};
$error
= $@;
}
if
(
$error
|| !
keys
%columns
)
{
no
warnings;
Carp::croak
"Could not auto-generate columns for class $class, table '"
,
$self
->table,
"' - $error"
;
}
$self
->auto_alias_columns(
values
%columns
);
return
wantarray
?
values
%columns
: \
%columns
;
}
my
$UK_Num
= 1;
sub
auto_generate_unique_keys
{
my
(
$self
) =
shift
;
unless
(
defined
wantarray
)
{
Carp::croak
"Useless call to auto_generate_unique_keys() in void context"
;
}
my
(
$class
,
%unique_keys
,
$error
);
TRY:
{
local
$@;
eval
{
my
$uk_info
= (
$self
->_table_info)[2] || [];
foreach
my
$info
(
@$uk_info
)
{
my
$uk_name
=
'unique_key_'
.
$UK_Num
++;
my
$uk
=
$unique_keys
{
$uk_name
} =
Rose::DB::Object::Metadata::UniqueKey->new(
name
=>
$uk_name
,
parent
=>
$self
);
foreach
my
$column
(
@$info
)
{
$uk
->add_column(
$column
);
}
$unique_keys
{
$uk_name
} =
$uk
;
}
};
$error
= $@;
}
if
(
$error
)
{
Carp::croak
"Could not auto-retrieve unique keys for class $class - $error"
;
}
my
@uk
=
map
{
$unique_keys
{
$_
} }
sort
map
{
lc
}
keys
(
%unique_keys
);
return
wantarray
?
@uk
: \
@uk
;
}
sub
auto_generate_foreign_keys
{
my
(
$self
,
%args
) =
@_
;
unless
(
defined
wantarray
)
{
Carp::croak
"Useless call to auto_generate_foreign_keys() in void context"
;
}
my
$no_warnings
=
$args
{
'no_warnings'
};
my
(
$class
,
@foreign_keys
,
$total_fks
,
$error
);
TRY:
{
local
$@;
eval
{
$class
=
$self
->class or
die
"Missing class!"
;
my
$db
=
$self
->db;
my
$dbh
=
$db
->dbh or
die
$db
->error;
my
$table_quoted
=
$db
->quote_table_name(
$self
->table);
local
$dbh
->{
'PrintWarn'
} = 0;
my
$sth
=
$dbh
->prepare(
"PRAGMA foreign_key_list($table_quoted)"
);
$sth
->execute;
my
%fk_info
;
while
(
my
$row
=
$sth
->fetchrow_hashref)
{
push
(@{
$fk_info
{
$row
->{
'id'
}}},
$row
);
}
my
$cm
=
$self
->convention_manager;
FK:
foreach
my
$id
(
sort
{
$a
<=>
$b
}
keys
(
%fk_info
))
{
my
$col_info
=
$fk_info
{
$id
};
my
$foreign_table
=
$col_info
->[0]{
'table'
};
my
$foreign_class
=
$self
->class_for(
table
=>
$foreign_table
);
unless
(
$foreign_class
)
{
$self
->add_deferred_task(
{
class
=>
$self
->class,
method
=>
'auto_init_foreign_keys'
,
args
=> \
%args
,
code
=>
sub
{
$self
->auto_init_foreign_keys(
%args
);
$self
->make_foreign_key_methods(
%args
,
preserve_existing
=> 1);
},
check
=>
sub
{
my
$fks
=
$self
->foreign_keys;
return
@$fks
==
$total_fks
? 1 : 0;
}
});
unless
(
$no_warnings
||
$self
->allow_auto_initialization)
{
no
warnings;
warn
"No Rose::DB::Object-derived class found for table "
,
"'$foreign_table'"
;
}
$total_fks
++;
next
FK;
}
my
(
@local_columns
,
@foreign_columns
);
foreach
my
$item
(
@$col_info
)
{
push
(
@local_columns
,
$item
->{
'from'
});
push
(
@foreign_columns
,
$item
->{
'to'
});
}
unless
(
@local_columns
> 0 &&
@local_columns
==
@foreign_columns
)
{
die
"Failed to extract a matched set of columns from "
,
'PRAGMA foreign_key_list('
,
$self
->table,
')'
;
}
my
%key_columns
;
@key_columns
{
@local_columns
} =
@foreign_columns
;
my
$fk
=
Rose::DB::Object::Metadata::ForeignKey->new(
class
=>
$foreign_class
,
key_columns
=> \
%key_columns
);
push
(
@foreign_keys
,
$fk
);
$total_fks
++;
}
@foreign_keys
=
sort
{
lc
$a
->class->meta->table cmp
lc
$b
->class->meta->table }
@foreign_keys
;
my
%used_names
;
foreach
my
$fk
(
@foreign_keys
)
{
my
$name
=
$cm
->auto_foreign_key_name(
$fk
->class,
$fk
->name,
scalar
$fk
->key_columns, \
%used_names
);
unless
(
defined
$name
)
{
$fk
->name(
$name
=
$self
->foreign_key_name_generator->(
$self
,
$fk
));
}
unless
(
defined
$name
&&
$name
=~ /^\w+$/)
{
die
"Missing or invalid key name '$name' for foreign key "
,
"generated in $class for "
,
$fk
->class;
}
$used_names
{
$name
}++;
$fk
->name(
$name
);
}
};
$error
= $@;
}
if
(
$error
)
{
Carp::croak
"Could not auto-generate foreign keys for class $class - $error"
;
}
@foreign_keys
=
sort
{
lc
$a
->name cmp
lc
$b
->name }
@foreign_keys
;
return
wantarray
?
@foreign_keys
: \
@foreign_keys
;
}
sub
_table_info
{
my
(
$self
) =
shift
;
$self
->db->_table_info(
$self
->table);
}
1;