test.pl

#!/usr/bin/env perl
use strict;
use warnings;

# mysql -h localhost test
# create table hoge (id int(10) auto_increment, hoge char(16), fuga char(16), t int(10), primary key (id));
# insert into hoge (hoge, fuga, t) values ('aaa', 'xxx', UNIX_TIMESTAMP()), ('bbb', 'yyy', UNIX_TIMESTAMP()), ('ccc', 'zzz', UNIX_TIMESTAMP());

package My::DB;
use DBIx::Skinny setup => +{
    dsn      => 'dbi:mysql:test',
    username => '',
    password => '',
};
1;




package My::DB::Schema;
use base qw/DBIx::Skinny::Schema::Loader/;
use DBIx::Skinny::Schema;

__PACKAGE__->load_schema;
1;




package main;
use Data::Dumper;
use Carp;
use Try::Tiny;

sub d {
    my $d = Dumper @_;
    print $d;
}


sub main {
    d [
        $],
        $DBI::VERSION,
        $DBIx::Skinny::VERSION,
    ];

    my $sk = My::DB->new;

    rs_test($sk, [
        {
            select => [
                '*'
            ],
            from => [
                'hoge',
            ],
        },

        {
            select => [
                'foo.*',
            ],
            from => [
                'hoge AS foo',
            ],
        },

        {
            select => [
                'foo.id AS id'
            ],
            from => [
                'hoge AS foo',
            ],
        },

        {
            select => [
                'foo.id id'
            ],
            from => [
                'hoge foo',
            ],
        },
    ]);

    print "\n**** finish ****\n";
}


sub rs_test {
    my ($sk, $patterns) = @_;
    my $i_test = 0;

    for my $p (@$patterns) {
        ++$i_test;
        print "\n**** Test: $i_test ****\n";
        _test($sk, $p);
    }
}

sub _test {
    my ($sk, $p) = @_;

    my $rs = $sk->resultset($p);
    d $rs->as_sql;

    try {
        my $itr;
        $itr = $rs->retrieve;
        #$itr = $rs->retrieve('hoge'); # どうテーブル名を保持しよう？
        #$itr = $sk->search_by_sql($rs->as_sql, $rs->bind);
        d $itr->count;
    }
    catch {
        carp shift;
    };
}


main();
__END__

@ Perl-5.12.1

$VAR1 = [
          '5.012001',
          '1.613',
          '0.0720'
        ];

**** Test: 1 ****
$VAR1 = 'SELECT *
FROM hoge
';
$VAR1 = 3;

**** Test: 2 ****
$VAR1 = 'SELECT foo.*
FROM hoge AS foo
';
Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/site_perl/5.12.1/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/site_perl/5.12.1 /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/5.12.1/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/5.12.1 .) at (eval 20) line 2.
BEGIN failed--compilation aborted at (eval 20) line 2.
 at ./test.pl line 113

**** Test: 3 ****
$VAR1 = 'SELECT foo.id AS id
FROM hoge AS foo
';
Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/site_perl/5.12.1/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/site_perl/5.12.1 /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/5.12.1/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/5.12.1 .) at (eval 21) line 2.
BEGIN failed--compilation aborted at (eval 21) line 2.
 at ./test.pl line 113

**** Test: 4 ****
$VAR1 = 'SELECT foo.id id
FROM hoge foo
';
Bareword "Foo" not allowed while "strict subs" in use at (eval 22) line 1.
 at ./test.pl line 113

**** finish ****




@ Perl-5.8.8 (とあるサーバの都合上)

$VAR1 = [
          '5.008008',
          '1.613',
          '0.0720'
        ];

**** Test: 1 ****
$VAR1 = 'SELECT *
FROM hoge
';
$VAR1 = 3;

**** Test: 2 ****
$VAR1 = 'SELECT foo.*
FROM hoge AS foo
';
Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl .) at (eval 18) line 2.
BEGIN failed--compilation aborted at (eval 18) line 2.
 at ./test.pl line 116

**** Test: 3 ****
$VAR1 = 'SELECT foo.id AS id
FROM hoge AS foo
';
Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl .) at (eval 19) line 2.
BEGIN failed--compilation aborted at (eval 19) line 2.
 at ./test.pl line 116

**** Test: 4 ****
$VAR1 = 'SELECT foo.id id
FROM hoge foo
';
Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl .) at (eval 20) line 2.
BEGIN failed--compilation aborted at (eval 20) line 2.
 at ./test.pl line 116

**** finish ****