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 )