CXC-DB-DDL
view release on metacpan or search on metacpan
lib/CXC/DB/DDL/Util.pm view on Meta::CPAN
# _exporter_expand_tag is called before _exporter_validate_opts,
# so init just in case
init( $globals );
my $stash = $globals->{ __PACKAGE__() };
my $dbd = $stash->{dbd};
# mindless copy from Exporter::Tiny::_exporter_expand_tag
return ( $class->_exporter_merge_opts( $value, $globals, @EXPORT_OK, keys types( $dbd )->%*, ) )
if $name eq 'all';
return ( $class->_exporter_merge_opts( $value, $globals, keys types( $dbd )->%*, ) )
if $name eq 'type_funcs';
if ( $name eq 'types' ) {
# first the standard ones
my @symbols = map { 'SQL_' . $_ } keys types( 'DBI' )->%*;
# and then the DBD specific ones
push @symbols, map { 'DBD_TYPE_' . $_ } keys types( $dbd, 'dbd' )->%*
if $dbd ne 'DBI';
return ( $class->_exporter_merge_opts( $value, $globals, @symbols ) );
}
$class->SUPER::_exporter_expand_tag( $name, $value, $globals );
}
sub _exporter_expand_sub ( $class, $name, $value, $globals, $permitted ) {
my $stash = $globals->{ __PACKAGE__() };
my $cache = $stash->{cache};
my $dbd = $stash->{dbd};
# just the standard SQL ones from DBI
return $class->_expand_type_class_sub( $name, $cache, 'DBI', 'dbd' )
if $name eq 'SQL_TYPE_NAMES' or $name eq 'SQL_TYPE_VALUES';
# Just those from the DBD
return $class->_expand_type_class_sub( $name, $cache, $dbd, 'dbd' )
if $name eq 'DBD_TYPE_NAMES' or $name eq 'DBD_TYPE_VALUES';
# All of 'em from DBI & from the DBD
return $class->_expand_type_class_sub( $name, $cache, $dbd, 'all' )
if $name eq 'TYPE_NAMES' or $name eq 'TYPE_VALUES';
if ( $name eq 'xTYPE' ) {
# field class may be specific to this use of Util, rather than dbd specific,
my $field_class = Module::Runtime::use_module( $stash->{field_class} );
return "&$name", $cache->{subs}{$name}{$field_class} //= set_subname $name, sub ( $type, %attr ) {
_mk_field( $name, $type, \%attr, $field_class );
};
}
if ( $name =~ /^(?<pfx>DBD_TYPE|SQL)_(?<type>.*)/ ) {
$dbd = 'DBI' if $+{pfx} eq 'SQL';
my \%types = $CACHE{$dbd}{types}{dbd};
return "&$name", $types{ $+{type} }
if exists $types{ $+{type} };
}
# $symbols is a locked hash, so can't just grab a value
my $symbols = types( $dbd );
if ( exists $symbols->{$name} && defined( my $sub = $symbols->{$name} ) ) {
return $class->_expand_field_sub( $cache, $stash->{field_class}, $name, $sub->() );
}
$class->SUPER::_exporter_expand_sub( $name, $value, $globals, $permitted );
}
( run in 2.728 seconds using v1.01-cache-2.11-cpan-5a3173703d6 )