view release on metacpan or  search on metacpan

lib/DBIx/Skinny.pm  view on Meta::CPAN

use Storable ();

sub import {
    my ($class, %opt) = @_;

    return if $class ne 'DBIx::Skinny';

    my $caller = caller;
    my $connect_info = $opt{connect_info};
    if (! $connect_info ) {
        if ( $connect_info = $opt{setup} ) {
            Carp::carp( "use DBIx::Skinny setup => { ... } has been deprecated. Please use connect_info instead" );
        } else {
            $connect_info = {};
        }
    }

    my $profiler = $opt{profiler};
    if (! $profiler ) {
        if ( $profiler = $connect_info->{profiler} ) {
            Carp::carp( "use DBIx::Skinny connect_info => { profiler => ... } has been deprecated. Please use use DBIx::Skinny profiler => ... instead" );
        } elsif ($ENV{SKINNY_TRACE}) {
            require DBIx::Skinny::Profiler::Trace;
            $profiler = DBIx::Skinny::Profiler::Trace->new;
        } elsif ($ENV{SKINNY_PROFILE}) {
            require DBIx::Skinny::Profiler;
            $profiler = DBIx::Skinny::Profiler->new;
        }
    }
                
    my $schema = $opt{schema} || "$caller\::Schema";

    my $driver_name = _guess_driver_name($connect_info);
    my $_attributes = +{
        check_schema    => defined $connect_info->{check_schema} ? $connect_info->{check_schema} : 1,
        dsn             => $connect_info->{dsn},
        username        => $connect_info->{username},
        password        => $connect_info->{password},
        connect_options => $connect_info->{connect_options},
        on_connect_do   => $connect_info->{on_connect_do},
        dbh             => $connect_info->{dbh}||undef,
        driver_name     => $driver_name,
        schema          => $schema,
        profiler        => $profiler,
        klass           => $caller,
        _common_row_class    => '',
        suppress_row_objects => 0,
        last_pid => $$,
    };

    {
        no strict 'refs';
        push @{"${caller}::ISA"}, $class;
        *{"$caller\::_attributes"} = sub { ref $_[0] ? $_[0] : $_attributes };
        *{"$caller\::attribute"} = sub { Carp::carp("attribute has been deprecated."); $_[0]->_attributes };
    }
    $caller->_setup_dbd;

    DBIx::Skinny::Util::load_class($schema);

    strict->import;
    warnings->import;
}

sub new {
    my ($class, $connection_info) = @_;
    my $attr = $class->_attributes;

    my $new_attr;
    for my $key (qw/check_schema dsn username password connect_options driver_name schema profiler klass _common_row_class suppress_row_objects/) {
        $new_attr->{$key} = $attr->{$key};
    }

    my $self = bless $new_attr, $class;
    $new_attr = $self->_attributes;
    $new_attr->{last_pid} = $$;

    # restore.
    for my $key (qw/dbd profiler dbh connect_options on_connect_do/) {
        $new_attr->{$key} = $attr->{$key};
    }

    if ($connection_info) {
        if ( $connection_info->{on_connect_do} ) {
            $new_attr->{on_connect_do} = $connection_info->{on_connect_do};
        }

        $self->connect_info($connection_info);
        if ($connection_info->{dbh}) {
            $self->set_dbh($connection_info->{dbh});
        } else {
            $self->reconnect;
        }
    }

    return $self;
}

my $schema_checked = 0;
sub schema { 
    my $attribute = $_[0]->_attributes;
    my $schema = $attribute->{schema};
    if ( $attribute->{check_schema} && !$schema_checked ) {
        {
            no strict 'refs'; ## no critic..
            unless ( defined *{"@{[ $schema ]}::schema_info"} ) {
                die "Cannot use schema $schema ( is it really loaded? )";
            }
        };
        $schema_checked=1;
    }
    return $schema;
}

sub profiler {
    my ($class, $sql, $bind) = @_;
    my $attr = $class->_attributes;
    if ($attr->{profiler} && $sql) {
        $attr->{profiler}->record_query($sql, $bind);
    }
    return $attr->{profiler};