add Oracle, DB2, Pg, ・ 0927ff4 ・ Gitprep

- add Oracle, DB2, Pg,;
- Browse files
- yuki-kimoto commited on 2009-11-16
- 1 parent dee79cc
  
  commit 0927ff47c1682c5f143d9ff0edc399a01d31e897

Showing 138 changed files with 111 additions and 15409 deletions

-25

DBIx-Custom-0.0501/Build.PL

@@ -1,25 +0,0 @@
-use strict;
-use warnings;
-use Module::Build;
-
-my $builder = Module::Build->new(
-    module_name         => 'DBIx::Custom',
-    license             => 'perl',
-    dist_author         => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
-    dist_version_from   => 'lib/DBIx/Custom.pm',
-    build_requires => {
-        'Test::More' => 0,
-    },
-    recommends => {
-        'DBD::SQLite' => 1.25,
-        'Time::Piece' => 1.15
-    },
-    requires => {
-        'Object::Simple' => 2.0702,
-        'DBI'            => 1.605,
-    },
-    add_to_cleanup      => [ 'DBIx-Custom-*' ],
-    create_makefile_pl => 'traditional',
-);
-
-$builder->create_build_script();

-11

DBIx-Custom-0.0501/Changes

View

@@ -1,11 +0,0 @@
-0.0501
-  packaging DBIx::Custom::Result DBIx::Custom::Query DBIx::Custom::MySQL DBIx::Custom::SQLite DBIx::Custom::SQL::Template 
-0.0401
-  catch up with DBIx::Custom::Result version up
-0.0301
-  exchange filter argument 'key', 'value' (not backword compatible)
-0.0201
-  rename tranzaction to transaction
-  add filter_off
-0.0101
-  First release

-15

DBIx-Custom-0.0501/README

View

@@ -1,15 +0,0 @@
-DBIx-Custom
-
-Custamizable DBI
-
-INSTALLATION
-
-cpan DBIx::Custom
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2009 Yuki Kimoto
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-2

DBIx-Custom-0.0501/_build/auto_features

View

...	...	@@ -1,2 +0,0 @@
1		-do{ my $x = {};
2		-$x; }

-280

DBIx-Custom-0.0501/_build/build_params

View

@@ -1,280 +0,0 @@
-do{ my $x = [
-       {
-         'ARGV' => []
-       },
-       {},
-       {
-         'verbose' => undef,
-         'PL_files' => undef,
-         'pollute' => undef,
-         'bindoc_dirs' => [
-                            'blib/script'
-                          ],
-         'conflicts' => {},
-         'scripts' => undef,
-         'recommends' => {
-                           'DBD::SQLite' => '1.25',
-                           'Time::Piece' => '1.15'
-                         },
-         'dist_version' => bless( {
-                                    'original' => '0.0501',
-                                    'version' => [
-                                                   0,
-                                                   50,
-                                                   100
-                                                 ]
-                                  }, 'Module::Build::Version' ),
-         'pod_files' => undef,
-         'config_dir' => '_build',
-         'sign' => undef,
-         'recurse_into' => [],
-         'build_bat' => 0,
-         'extra_linker_flags' => [],
-         'build_class' => 'Module::Build',
-         'prereq_action_types' => [
-                                    'requires',
-                                    'build_requires',
-                                    'conflicts',
-                                    'recommends'
-                                  ],
-         'base_dir' => '/root/labo/DBIx-Custom/DBIx-Custom-0.0501',
-         'allow_mb_mismatch' => 0,
-         'xs_files' => undef,
-         'destdir' => undef,
-         'metafile' => 'META.yml',
-         'mb_version' => '0.31012',
-         'use_tap_harness' => 0,
-         'test_file_exts' => [
-                               '.t'
-                             ],
-         'dist_name' => 'DBIx-Custom',
-         'has_config_data' => undef,
-         'install_base' => undef,
-         'module_name' => 'DBIx::Custom',
-         'recursive_test_files' => undef,
-         'libdoc_dirs' => [
-                            'blib/lib',
-                            'blib/arch'
-                          ],
-         'perl' => '/usr/bin/perl',
-         'dist_author' => [
-                            'Yuki Kimoto <kimoto.yuki@gmail.com>'
-                          ],
-         'use_rcfile' => 1,
-         'configure_requires' => {},
-         'test_files' => undef,
-         'dist_abstract' => undef,
-         'create_readme' => undef,
-         'prefix_relpaths' => {
-                                'core' => {
-                                            'libdoc' => [
-                                                          'man',
-                                                          'man3'
-                                                        ],
-                                            'script' => [
-                                                          'bin'
-                                                        ],
-                                            'libhtml' => [
-                                                           'html'
-                                                         ],
-                                            'bindoc' => [
-                                                          'man',
-                                                          'man1'
-                                                        ],
-                                            'bin' => [
-                                                       'bin'
-                                                     ],
-                                            'arch' => [
-                                                        'lib',
-                                                        'perl5',
-                                                        '5.8.8',
-                                                        'i386-linux-thread-multi'
-                                                      ],
-                                            'binhtml' => [
-                                                           'html'
-                                                         ],
-                                            'lib' => [
-                                                       'lib',
-                                                       'perl5'
-                                                     ]
-                                          },
-                                'site' => {
-                                            'libdoc' => [
-                                                          'man',
-                                                          'man3'
-                                                        ],
-                                            'script' => [
-                                                          'bin'
-                                                        ],
-                                            'libhtml' => [
-                                                           'html'
-                                                         ],
-                                            'bindoc' => [
-                                                          'man',
-                                                          'man1'
-                                                        ],
-                                            'bin' => [
-                                                       'bin'
-                                                     ],
-                                            'arch' => [
-                                                        'lib',
-                                                        'perl5',
-                                                        'site_perl',
-                                                        '5.8.8',
-                                                        'i386-linux-thread-multi'
-                                                      ],
-                                            'binhtml' => [
-                                                           'html'
-                                                         ],
-                                            'lib' => [
-                                                       'lib',
-                                                       'perl5',
-                                                       'site_perl'
-                                                     ]
-                                          },
-                                'vendor' => {
-                                              'libdoc' => [
-                                                            'man',
-                                                            'man3'
-                                                          ],
-                                              'script' => [
-                                                            'bin'
-                                                          ],
-                                              'libhtml' => [
-                                                             'html'
-                                                           ],
-                                              'bindoc' => [
-                                                            'man',
-                                                            'man1'
-                                                          ],
-                                              'bin' => [
-                                                         'bin'
-                                                       ],
-                                              'arch' => [
-                                                          'lib',
-                                                          'perl5',
-                                                          '5.8.8',
-                                                          'i386-linux-thread-multi'
-                                                        ],
-                                              'binhtml' => [
-                                                             'html'
-                                                           ],
-                                              'lib' => [
-                                                         'lib',
-                                                         'perl5'
-                                                       ]
-                                            }
-                              },
-         'meta_merge' => {},
-         'get_options' => {},
-         'dist_version_from' => 'lib/DBIx/Custom.pm',
-         'create_license' => undef,
-         'debugger' => undef,
-         'html_css' => '',
-         'build_elements' => [
-                               'PL',
-                               'support',
-                               'pm',
-                               'xs',
-                               'pod',
-                               'script'
-                             ],
-         'orig_dir' => '/root/labo/DBIx-Custom/DBIx-Custom-0.0501',
-         'include_dirs' => [],
-         'installdirs' => 'site',
-         'create_makefile_pl' => 'traditional',
-         'magic_number' => undef,
-         'install_sets' => {
-                             'core' => {
-                                         'libdoc' => '/usr/share/man/man3',
-                                         'script' => '/usr/bin',
-                                         'libhtml' => undef,
-                                         'bindoc' => '/usr/share/man/man1',
-                                         'bin' => '/usr/bin',
-                                         'arch' => '/usr/lib/perl5/5.8.8/i386-linux-thread-multi',
-                                         'binhtml' => undef,
-                                         'lib' => '/usr/lib/perl5/5.8.8'
-                                       },
-                             'site' => {
-                                         'libdoc' => '/usr/share/man/man3',
-                                         'script' => '/usr/bin',
-                                         'libhtml' => undef,
-                                         'bindoc' => '/usr/share/man/man1',
-                                         'bin' => '/usr/bin',
-                                         'arch' => '/usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi',
-                                         'binhtml' => undef,
-                                         'lib' => '/usr/lib/perl5/site_perl/5.8.8'
-                                       },
-                             'vendor' => {
-                                           'libdoc' => '/usr/share/man/man3',
-                                           'script' => '/usr/bin',
-                                           'libhtml' => undef,
-                                           'bindoc' => '/usr/share/man/man1',
-                                           'bin' => '/usr/bin',
-                                           'arch' => '/usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi',
-                                           'binhtml' => undef,
-                                           'lib' => '/usr/lib/perl5/vendor_perl/5.8.8'
-                                         }
-                           },
-         'tap_harness_args' => {},
-         'install_base_relpaths' => {
-                                      'libdoc' => [
-                                                    'man',
-                                                    'man3'
-                                                  ],
-                                      'script' => [
-                                                    'bin'
-                                                  ],
-                                      'libhtml' => [
-                                                     'html'
-                                                   ],
-                                      'bindoc' => [
-                                                    'man',
-                                                    'man1'
-                                                  ],
-                                      'bin' => [
-                                                 'bin'
-                                               ],
-                                      'arch' => [
-                                                  'lib',
-                                                  'perl5',
-                                                  'i386-linux-thread-multi'
-                                                ],
-                                      'binhtml' => [
-                                                     'html'
-                                                   ],
-                                      'lib' => [
-                                                 'lib',
-                                                 'perl5'
-                                               ]
-                                    },
-         'meta_add' => {},
-         'create_packlist' => 1,
-         'requires' => {
-                         'Object::Simple' => '2.0702',
-                         'DBI' => '1.605'
-                       },
-         'install_path' => {},
-         'pm_files' => undef,
-         'quiet' => undef,
-         'script_files' => undef,
-         'extra_compiler_flags' => [],
-         'build_script' => 'Build',
-         'original_prefix' => {
-                                'core' => '/usr',
-                                'site' => '/usr',
-                                'vendor' => '/usr'
-                              },
-         'c_source' => undef,
-         'autosplit' => undef,
-         'program_name' => undef,
-         'license' => 'perl',
-         'build_requires' => {
-                               'Test::More' => 0
-                             },
-         'config' => undef,
-         'blib' => 'blib',
-         'prefix' => undef
-       }
-     ];
-$x; }

-5

DBIx-Custom-0.0501/_build/cleanup

View

...	...	@@ -1,5 +0,0 @@
1		-do{ my $x = {
2		- 'blib' => 1,
3		- 'DBIx-Custom-*' => 1
4		- };
5		-$x; }

-2

DBIx-Custom-0.0501/_build/config_data

View

...	...	@@ -1,2 +0,0 @@
1		-do{ my $x = {};
2		-$x; }

-2

DBIx-Custom-0.0501/_build/features

View

...	...	@@ -1,2 +0,0 @@
1		-do{ my $x = {};
2		-$x; }

-1

DBIx-Custom-0.0501/_build/magicnum

View

...	...	@@ -1 +0,0 @@
1		-793374

-2

DBIx-Custom-0.0501/_build/notes

View

...	...	@@ -1,2 +0,0 @@
1		-do{ my $x = {};
2		-$x; }

-15

DBIx-Custom-0.0501/_build/prereqs

View

...	...	@@ -1,15 +0,0 @@
1		-do{ my $x = {
2		- 'build_requires' => {
3		- 'Test::More' => 0
4		- },
5		- 'conflicts' => {},
6		- 'requires' => {
7		- 'Object::Simple' => '2.0702',
8		- 'DBI' => '1.605'
9		- },
10		- 'recommends' => {
11		- 'DBD::SQLite' => '1.25',
12		- 'Time::Piece' => '1.15'
13		- }
14		- };
15		-$x; }

-2

DBIx-Custom-0.0501/_build/runtime_params

View

...	...	@@ -1,2 +0,0 @@
1		-do{ my $x = {};
2		-$x; }

-1127

DBIx-Custom-0.0501/blib/lib/DBIx/Custom.pm

View

@@ -1,1127 +0,0 @@
-use 5.008001;
-
-package DBIx::Custom;
-use Object::Simple;
-
-our $VERSION = '0.0501';
-
-use Carp 'croak';
-use DBI;
-use DBIx::Custom::Query;
-use DBIx::Custom::Result;
-use DBIx::Custom::SQL::Template;
-
-
-### Class-Object Accessors
-sub user        : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub password    : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub data_source : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub dbi_options : ClassObjectAttr { initialize => {clone => 'hash', 
-                                                   default => sub { {} } } }
-sub database    : ClassObjectAttr { initialize => {clone => 'scalar'} }
-
-sub bind_filter  : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub fetch_filter : ClassObjectAttr { initialize => {clone => 'scalar'} }
-
-sub no_bind_filters   : ClassObjectAttr { initialize => {clone => 'array'} }
-sub no_fetch_filters  : ClassObjectAttr { initialize => {clone => 'array'} }
-
-sub filters : ClassObjectAttr {
-    type => 'hash',
-    deref => 1,
-    initialize => {
-        clone   => 'hash',
-        default => sub { {} }
-    }
-}
-
-sub formats : ClassObjectAttr {
-    type => 'hash',
-    deref => 1,
-    initialize => {
-        clone   => 'hash',
-        default => sub { {} }
-    }
-}
-
-sub result_class : ClassObjectAttr {
-    initialize => {
-        clone   => 'scalar',
-        default => 'DBIx::Custom::Result'
-    }
-}
-
-sub sql_template : ClassObjectAttr {
-    initialize => {
-        clone   => sub {$_[0] ? $_[0]->clone : undef},
-        default => sub {DBIx::Custom::SQL::Template->new}
-    }
-}
-
-### Object Accessor
-sub dbh          : Attr {}
-
-
-### Methods
-
-# Add filter
-sub add_filter {
-    my $invocant = shift;
-    
-    my %old_filters = $invocant->filters;
-    my %new_filters = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
-    $invocant->filters(%old_filters, %new_filters);
-    return $invocant;
-}
-
-# Add format
-sub add_format{
-    my $invocant = shift;
-    
-    my %old_formats = $invocant->formats;
-    my %new_formats = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
-    $invocant->formats(%old_formats, %new_formats);
-    return $invocant;
-}
-
-# Auto commit
-sub _auto_commit {
-    my $self = shift;
-    
-    croak("Not yet connect to database") unless $self->dbh;
-    
-    if (@_) {
-        $self->dbh->{AutoCommit} = $_[0];
-        return $self;
-    }
-    return $self->dbh->{AutoCommit};
-}
-
-# Connect
-sub connect {
-    my $self = shift;
-    my $data_source = $self->data_source;
-    my $user        = $self->user;
-    my $password    = $self->password;
-    my $dbi_options  = $self->dbi_options;
-    
-    my $dbh = eval{DBI->connect(
-        $data_source,
-        $user,
-        $password,
-        {
-            RaiseError => 1,
-            PrintError => 0,
-            AutoCommit => 1,
-            %{$dbi_options || {} }
-        }
-    )};
-    
-    croak $@ if $@;
-    
-    $self->dbh($dbh);
-    return $self;
-}
-
-# DESTROY
-sub DESTROY {
-    my $self = shift;
-    $self->disconnect if $self->connected;
-}
-
-# Is connected?
-sub connected {
-    my $self = shift;
-    return ref $self->{dbh} eq 'DBI::db';
-}
-
-# Disconnect
-sub disconnect {
-    my $self = shift;
-    if ($self->connected) {
-        $self->dbh->disconnect;
-        delete $self->{dbh};
-    }
-}
-
-# Reconnect
-sub reconnect {
-    my $self = shift;
-    $self->disconnect if $self->connected;
-    $self->connect;
-}
-
-# Prepare statement handle
-sub prepare {
-    my ($self, $sql) = @_;
-    
-    # Connect if not
-    $self->connect unless $self->connected;
-    
-    # Prepare
-    my $sth = eval{$self->dbh->prepare($sql)};
-    
-    # Error
-    croak("$@<Your SQL>\n$sql") if $@;
-    
-    return $sth;
-}
-
-# Execute SQL directly
-sub do{
-    my ($self, $sql, @bind_values) = @_;
-    
-    # Connect if not
-    $self->connect unless $self->connected;
-    
-    # Do
-    my $ret_val = eval{$self->dbh->do($sql, @bind_values)};
-    
-    # Error
-    if ($@) {
-        my $error = $@;
-        require Data::Dumper;
-        
-        my $bind_value_dump
-          = Data::Dumper->Dump([\@bind_values], ['*bind_valuds']);
-        
-        croak("$error<Your SQL>\n$sql\n<Your bind values>\n$bind_value_dump\n");
-    }
-}
-
-# Create query
-sub create_query {
-    my ($self, $template) = @_;
-    my $class = ref $self;
-    
-    # Create query from SQL template
-    my $sql_template = $self->sql_template;
-    
-    # Try to get cached query
-    my $query = $class->_query_caches->{$template};
-    
-    # Create query
-    unless ($query) {
-        $query = eval{$sql_template->create_query($template)};
-        croak($@) if $@;
-        
-        $query = DBIx::Custom::Query->new($query);
-        
-        $class->_add_query_cache($template, $query);
-    }
-    
-    # Connect if not
-    $self->connect unless $self->connected;
-    
-    # Prepare statement handle
-    my $sth = $self->prepare($query->{sql});
-    
-    # Set statement handle
-    $query->sth($sth);
-    
-    # Set bind filter
-    $query->bind_filter($self->bind_filter);
-    
-    # Set no filter keys when binding
-    $query->no_bind_filters($self->no_bind_filters);
-    
-    # Set fetch filter
-    $query->fetch_filter($self->fetch_filter);
-    
-    # Set no filter keys when fetching
-    $query->no_fetch_filters($self->no_fetch_filters);
-    
-    return $query;
-}
-
-# Execute query
-sub execute {
-    my ($self, $query, $params)  = @_;
-    $params ||= {};
-    
-    # First argument is SQL template
-    if (!ref $query) {
-        my $template = $query;
-        $query = $self->create_query($template);
-        my $query_edit_cb = $_[3];
-        $query_edit_cb->($query) if ref $query_edit_cb eq 'CODE';
-    }
-    
-    # Create bind value
-    my $bind_values = $self->_build_bind_values($query, $params);
-    
-    # Execute
-    my $sth = $query->sth;
-    my $ret_val = eval{$sth->execute(@$bind_values)};
-    
-    # Execute error
-    if (my $execute_error = $@) {
-        require Data::Dumper;
-        my $sql              = $query->{sql} || '';
-        my $key_infos_dump   = Data::Dumper->Dump([$query->key_infos], ['*key_infos']);
-        my $params_dump      = Data::Dumper->Dump([$params], ['*params']);
-        
-        croak("$execute_error" . 
-              "<Your SQL>\n$sql\n" . 
-              "<Your parameters>\n$params_dump");
-    }
-    
-    # Return resultset if select statement is executed
-    if ($sth->{NUM_OF_FIELDS}) {
-        
-        # Get result class
-        my $result_class = $self->result_class;
-        
-        # Create result
-        my $result = $result_class->new({
-            sth              => $sth,
-            fetch_filter     => $query->fetch_filter,
-            no_fetch_filters => $query->no_fetch_filters
-        });
-        return $result;
-    }
-    return $ret_val;
-}
-
-# Build binding values
-sub _build_bind_values {
-    my ($self, $query, $params) = @_;
-    my $key_infos           = $query->key_infos;
-    my $bind_filter         = $query->bind_filter;
-    my $no_bind_filters_map = $query->_no_bind_filters_map || {};
-    
-    # binding values
-    my @bind_values;
-    
-    # Create bind values
-    KEY_INFOS :
-    foreach my $key_info (@$key_infos) {
-        # Set variable
-        my $access_keys  = $key_info->{access_keys};
-        my $original_key = $key_info->{original_key} || '';
-        my $table        = $key_info->{table}        || '';
-        my $column       = $key_info->{column}       || '';
-        
-        # Key is found?
-        my $found;
-        
-        # Build bind values
-        ACCESS_KEYS :
-        foreach my $access_key (@$access_keys) {
-            # Root parameter
-            my $root_params = $params;
-            
-            # Search corresponding value
-            for (my $i = 0; $i < @$access_key; $i++) {
-                # Current key
-                my $current_key = $access_key->[$i];
-                
-                # Last key
-                if ($i == @$access_key - 1) {
-                    # Key is array reference
-                    if (ref $current_key eq 'ARRAY') {
-                        # Filtering 
-                        if ($bind_filter &&
-                            !$no_bind_filters_map->{$original_key})
-                        {
-                            push @bind_values, 
-                                 $bind_filter->($root_params->[$current_key->[0]], 
-                                                $original_key,
-                                                $table, $column);
-                        }
-                        # Not filtering
-                        else {
-                            push @bind_values,
-                                 scalar $root_params->[$current_key->[0]];
-                        }
-                    }
-                    # Key is string
-                    else {
-                        # Key is not found
-                        next ACCESS_KEYS
-                          unless exists $root_params->{$current_key};
-                        
-                        # Filtering
-                        if ($bind_filter &&
-                            !$no_bind_filters_map->{$original_key}) 
-                        {
-                            push @bind_values,
-                                 $bind_filter->($root_params->{$current_key},
-                                                $original_key,
-                                                $table, $column);
-                        }
-                        # Not filtering
-                        else {
-                            push @bind_values,
-                                 scalar $root_params->{$current_key};
-                        }
-                    }
-                    
-                    # Key is found
-                    $found = 1;
-                    next KEY_INFOS;
-                }
-                # First or middle key
-                else {
-                    # Key is array reference
-                    if (ref $current_key eq 'ARRAY') {
-                        # Go next key
-                        $root_params = $root_params->[$current_key->[0]];
-                    }
-                    # Key is string
-                    else {
-                        # Not found
-                        next ACCESS_KEYS
-                          unless exists $root_params->{$current_key};
-                        
-                        # Go next key
-                        $root_params = $root_params->{$current_key};
-                    }
-                }
-            }
-        }
-        
-        # Key is not found
-        unless ($found) {
-            require Data::Dumper;
-            my $key_info_dump  = Data::Dumper->Dump([$key_info], ['*key_info']);
-            my $params_dump    = Data::Dumper->Dump([$params], ['*params']);
-            croak("Corresponding key is not found in your parameters\n" . 
-                  "<Key information>\n$key_info_dump\n\n" .
-                  "<Your parameters>\n$params_dump\n");
-        }
-    }
-    return \@bind_values;
-}
-
-# Run transaction
-sub run_transaction {
-    my ($self, $transaction) = @_;
-    
-    # Check auto commit
-    croak("AutoCommit must be true before transaction start")
-      unless $self->_auto_commit;
-    
-    # Auto commit off
-    $self->_auto_commit(0);
-    
-    # Run transaction
-    eval {$transaction->()};
-    
-    # Tranzaction error
-    my $transaction_error = $@;
-    
-    # Tranzaction is failed.
-    if ($transaction_error) {
-        # Rollback
-        eval{$self->dbh->rollback};
-        
-        # Rollback error
-        my $rollback_error = $@;
-        
-        # Auto commit on
-        $self->_auto_commit(1);
-        
-        if ($rollback_error) {
-            # Rollback is failed
-            croak("${transaction_error}Rollback is failed : $rollback_error");
-        }
-        else {
-            # Rollback is success
-            croak("${transaction_error}Rollback is success");
-        }
-    }
-    # Tranzaction is success
-    else {
-        # Commit
-        eval{$self->dbh->commit};
-        my $commit_error = $@;
-        
-        # Auto commit on
-        $self->_auto_commit(1);
-        
-        # Commit is failed
-        croak($commit_error) if $commit_error;
-    }
-}
-
-# Get last insert id
-sub last_insert_id {
-    my $self = shift;
-    
-    # Not connected
-    croak("Not yet connect to database")
-      unless $self->connected;
-    
-    return $self->dbh->last_insert_id(@_);
-}
-
-# Insert
-sub insert {
-    my ($self, $table, $insert_params, $query_edit_cb) = @_;
-    $table         ||= '';
-    $insert_params ||= {};
-    
-    # Insert keys
-    my @insert_keys = keys %$insert_params;
-    
-    # Not exists insert keys
-    croak("Key-value pairs for insert must be specified to 'insert' second argument")
-      unless @insert_keys;
-    
-    # Templte for insert
-    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit callback must be code reference
-    croak("Query edit callback must be code reference")
-      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
-    
-    # Query edit if need
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Execute query
-    my $ret_val = $self->execute($query, $insert_params);
-    
-    return $ret_val;
-}
-
-# Update
-sub update {
-    my ($self, $table, $update_params,
-        $where_params, $query_edit_cb, $options) = @_;
-    
-    $table         ||= '';
-    $update_params ||= {};
-    $where_params  ||= {};
-    
-    # Update keys
-    my @update_keys = keys %$update_params;
-    
-    # Not exists update kyes
-    croak("Key-value pairs for update must be specified to 'update' second argument")
-      unless @update_keys;
-    
-    # Where keys
-    my @where_keys = keys %$where_params;
-    
-    # Not exists where keys
-    croak("Key-value pairs for where clause must be specified to 'update' third argument")
-      if !@where_keys && !$options->{allow_update_all};
-    
-    # Update clause
-    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
-    
-    # Where clause
-    my $where_clause = '';
-    if (@where_keys) {
-        $where_clause = 'where ';
-        foreach my $where_key (@where_keys) {
-            $where_clause .= "{= $where_key} and ";
-        }
-        $where_clause =~ s/ and $//;
-    }
-    
-    # Template for update
-    my $template = "update $table $update_clause $where_clause";
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit callback must be code reference
-    croak("Query edit callback must be code reference")
-      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
-    
-    # Query edit if need
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Rearrange parammeters
-    my $params = {'#update' => $update_params, %$where_params};
-    
-    # Execute query
-    my $ret_val = $self->execute($query, $params);
-    
-    return $ret_val;
-}
-
-# Update all rows
-sub update_all {
-    my ($self, $table, $update_params, $query_edit_cb) = @_;
-    
-    return $self->update($table, $update_params, {}, $query_edit_cb,
-                         {allow_update_all => 1});
-}
-
-# Delete
-sub delete {
-    my ($self, $table, $where_params, $query_edit_cb, $options) = @_;
-    $table        ||= '';
-    $where_params ||= {};
-    
-    # Where keys
-    my @where_keys = keys %$where_params;
-    
-    # Not exists where keys
-    croak("Key-value pairs for where clause must be specified to 'delete' second argument")
-      if !@where_keys && !$options->{allow_delete_all};
-    
-    # Where clause
-    my $where_clause = '';
-    if (@where_keys) {
-        $where_clause = 'where ';
-        foreach my $where_key (@where_keys) {
-            $where_clause .= "{= $where_key} and ";
-        }
-        $where_clause =~ s/ and $//;
-    }
-    
-    # Template for delete
-    my $template = "delete from $table $where_clause";
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit callback must be code reference
-    croak("Query edit callback must be code reference")
-      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
-    
-    # Query edit if need
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Execute query
-    my $ret_val = $self->execute($query, $where_params);
-    
-    return $ret_val;
-}
-
-# Delete all rows
-sub delete_all {
-    my ($self, $table) = @_;
-    return $self->delete($table, {}, undef, {allow_delete_all => 1});
-}
-
-sub _select_usage { return << 'EOS' }
-Your select arguments is wrong.
-select usage:
-$dbi->select(
-    $table,                # must be string or array ref
-    [@$columns],           # must be array reference. this is optional
-    {%$where_params},      # must be hash reference.  this is optional
-    $append_statement,     # must be string.          this is optional
-    $query_edit_callback   # must be code reference.  this is optional
-);
-EOS
-
-sub select {
-    my $self = shift;
-    
-    # Check argument
-    croak($self->_select_usage) unless @_;
-    
-    # Arguments
-    my $tables = shift || '';
-    $tables    = [$tables] unless ref $tables;
-    
-    my $columns          = ref $_[0] eq 'ARRAY' ? shift : [];
-    my $where_params     = ref $_[0] eq 'HASH'  ? shift : {};
-    my $append_statement = $_[0] && !ref $_[0]  ? shift : '';
-    my $query_edit_cb    = shift if ref $_[0] eq 'CODE';
-    
-    # Check rest argument
-    croak($self->_select_usage) if @_;
-    
-    # SQL template for select statement
-    my $template = 'select ';
-    
-    # Join column clause
-    if (@$columns) {
-        foreach my $column (@$columns) {
-            $template .= "$column, ";
-        }
-        $template =~ s/, $/ /;
-    }
-    else {
-        $template .= '* ';
-    }
-    
-    # Join table
-    $template .= 'from ';
-    foreach my $table (@$tables) {
-        $template .= "$table, ";
-    }
-    $template =~ s/, $/ /;
-    
-    # Where clause keys
-    my @where_keys = keys %$where_params;
-    
-    # Join where clause
-    if (@where_keys) {
-        $template .= 'where ';
-        foreach my $where_key (@where_keys) {
-            $template .= "{= $where_key} and ";
-        }
-    }
-    $template =~ s/ and $//;
-    
-    # Append something to last of statement
-    if ($append_statement =~ s/^where //) {
-        if (@where_keys) {
-            $template .= " and $append_statement";
-        }
-        else {
-            $template .= " where $append_statement";
-        }
-    }
-    else {
-        $template .= " $append_statement";
-    }
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Execute query
-    my $result = $self->execute($query, $where_params);
-    
-    return $result;
-}
-
-sub _query_caches     : ClassAttr { type => 'hash',
-                                    auto_build => sub {shift->_query_caches({}) } }
-                                    
-sub _query_cache_keys : ClassAttr { type => 'array',
-                                    auto_build => sub {shift->_query_cache_keys([])} }
-                                    
-sub query_cache_max   : ClassAttr { auto_build => sub {shift->query_cache_max(50)} }
-
-# Add query cahce
-sub _add_query_cache {
-    my ($class, $template, $query) = @_;
-    my $query_cache_keys = $class->_query_cache_keys;
-    my $query_caches     = $class->_query_caches;
-    
-    return $class if $query_caches->{$template};
-    
-    $query_caches->{$template} = $query;
-    push @$query_cache_keys, $template;
-    
-    my $overflow = @$query_cache_keys - $class->query_cache_max;
-    
-    for (my $i = 0; $i < $overflow; $i++) {
-        my $template = shift @$query_cache_keys;
-        delete $query_caches->{$template};
-    }
-    
-    return $class;
-}
-
-# Both bind_filter and fetch_filter off
-sub filter_off {
-    my $self = shift;
-    
-    # filter off
-    $self->bind_filter(undef);
-    $self->fetch_filter(undef);
-    
-    return $self;
-}
-
-Object::Simple->build_class;
-
-=head1 NAME
-
-DBIx::Custom - Customizable simple DBI
-
-=head1 VERSION
-
-Version 0.0501
-
-=head1 CAUTION
-
-This module is now experimental stage.
-
-I want you to try this module
-because I want this module stable, and not to damage your DB data by this module bug.
-
-Please tell me bug if you find
-
-=head1 SYNOPSIS
-
-  my $dbi = DBIx::Custom->new;
-  
-  my $query = $dbi->create_query($template);
-  $dbi->execute($query);
-
-=head1 CLASS-OBJECT ACCESSORS
-
-=head2 user
-
-    # Set and get database user name
-    $self = $dbi->user($user);
-    $user = $dbi->user;
-    
-    # Sample
-    $dbi->user('taro');
-
-=head2 password
-
-    # Set and get database password
-    $self     = $dbi->password($password);
-    $password = $dbi->password;
-    
-    # Sample
-    $dbi->password('lkj&le`@s');
-
-=head2 data_source
-
-    # Set and get database data source
-    $self        = $dbi->data_source($data_soruce);
-    $data_source = $dbi->data_source;
-    
-    # Sample(SQLite)
-    $dbi->data_source(dbi:SQLite:dbname=$database);
-    
-    # Sample(MySQL);
-    $dbi->data_source("dbi:mysql:dbname=$database");
-    
-    # Sample(PostgreSQL)
-    $dbi->data_source("dbi:Pg:dbname=$database");
-    
-=head2 database
-
-    # Set and get database name
-    $self     = $dbi->database($database);
-    $database = $dbi->database;
-
-This method will be used in subclass connect method.
-
-=head2 dbi_options
-
-    # Set and get DBI option
-    $self       = $dbi->dbi_options({$options => $value, ...});
-    $dbi_options = $dbi->dbi_options;
-
-    # Sample
-    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
-
-dbi_options is used when you connect database by using connect.
-
-=head2 prepare
-
-    $sth = $dbi->prepare($sql);
-
-This method is same as DBI::prepare
-
-=head2 do
-
-    $dbi->do($sql, @bind_values);
-
-This method is same as DBI::do
-
-=head2 sql_template
-
-    # Set and get SQL::Template object
-    $self         = $dbi->sql_template($sql_template);
-    $sql_template = $dbi->sql_template;
-    
-    # Sample
-    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
-
-=head2 filters
-
-    # Set and get filters
-    $self    = $dbi->filters($filters);
-    $filters = $dbi->filters;
-
-=head2 formats
-
-    # Set and get formats
-    $self    = $dbi->formats($formats);
-    $formats = $dbi->formats;
-    
-=head2 bind_filter
-
-    # Set and get binding filter
-    $self        = $dbi->bind_filter($bind_filter);
-    $bind_filter = $dbi->bind_filter
-
-    # Sample
-    $dbi->bind_filter($self->filters->{default_bind_filter});
-    
-
-you can get DBI database handle if you need.
-
-=head2 fetch_filter
-
-    # Set and get Fetch filter
-    $self         = $dbi->fetch_filter($fetch_filter);
-    $fetch_filter = $dbi->fetch_filter;
-
-    # Sample
-    $dbi->fetch_filter($self->filters->{default_fetch_filter});
-
-=head2 no_bind_filters
-
-    # Set and get no filter keys when binding
-    $self            = $dbi->no_bind_filters($no_bind_filters);
-    $no_bind_filters = $dbi->no_bind_filters;
-
-=head2 no_fetch_filters
-
-    # Set and get no filter keys when fetching
-    $self             = $dbi->no_fetch_filters($no_fetch_filters);
-    $no_fetch_filters = $dbi->no_fetch_filters;
-
-=head2 result_class
-
-    # Set and get resultset class
-    $self         = $dbi->result_class($result_class);
-    $result_class = $dbi->result_class;
-    
-    # Sample
-    $dbi->result_class('DBIx::Custom::Result');
-
-=head2 dbh
-
-    # Get database handle
-    $dbh = $self->dbh;
-
-=head1 METHODS
-
-=head2 connect
-
-    # Connect to database
-    $self = $dbi->connect;
-    
-    # Sample
-    $dbi = DBIx::Custom->new(user => 'taro', password => 'lji8(', 
-                            data_soruce => "dbi:mysql:dbname=$database");
-    $dbi->connect;
-
-=head2 disconnect
-
-    # Disconnect database
-    $dbi->disconnect;
-
-If database is already disconnected, this method do noting.
-
-=head2 reconnect
-
-    # Reconnect
-    $dbi->reconnect;
-
-=head2 connected
-
-    # Check connected
-    $dbi->connected
-    
-=head2 filter_off
-
-    # bind_filter and fitch_filter off
-    $self->filter_off;
-    
-This is equeal to
-    
-    $self->bind_filter(undef);
-    $self->fetch_filter(undef);
-
-=head2 add_filter
-
-    # Add filter (hash ref or hash can be recieve)
-    $self = $dbi->add_filter({$filter_name => $filter, ...});
-    $self = $dbi->add_filter($filetr_name => $filter, ...);
-    
-    # Sample
-    $dbi->add_filter(
-        decode_utf8 => sub {
-            my ($key, $value, $table, $column) = @_;
-            return Encode::decode('UTF-8', $value);
-        },
-        datetime_to_string => sub {
-            my ($key, $value, $table, $column) = @_;
-            return $value->strftime('%Y-%m-%d %H:%M:%S')
-        },
-        default_bind_filter => sub {
-            my ($key, $value, $table, $column) = @_;
-            if (ref $value eq 'Time::Piece') {
-                return $dbi->filters->{datetime_to_string}->($value);
-            }
-            else {
-                return $dbi->filters->{decode_utf8}->($value);
-            }
-        },
-        
-        encode_utf8 => sub {
-            my ($key, $value) = @_;
-            return Encode::encode('UTF-8', $value);
-        },
-        string_to_datetime => sub {
-            my ($key, $value) = @_;
-            return DateTime::Format::MySQL->parse_datetime($value);
-        },
-        default_fetch_filter => sub {
-            my ($key, $value, $type, $sth, $i) = @_;
-            if ($type eq 'DATETIME') {
-                return $dbi->filters->{string_to_datetime}->($value);
-            }
-            else {
-                return $dbi->filters->{encode_utf8}->($value);
-            }
-        }
-    );
-
-add_filter add filter to filters
-
-=head2 add_format
-
-    $dbi->add_format(date => '%Y:%m:%d');
-
-=head2 create_query
-    
-    # Create Query object from SQL template
-    my $query = $dbi->create_query($template);
-    
-=head2 execute
-
-    # Parse SQL template and execute SQL
-    $result = $dbi->query($query, $params);
-    $result = $dbi->query($template, $params); # Shorcut
-    
-    # Sample
-    $result = $dbi->query("select * from authors where {= name} and {= age}", 
-                          {author => 'taro', age => 19});
-    
-    while (my @row = $result->fetch) {
-        # do something
-    }
-
-See also L<DBIx::Custom::SQL::Template>
-
-=head2 run_transaction
-
-    # Run transaction
-    $dbi->run_transaction(sub {
-        # do something
-    });
-
-If transaction is success, commit is execute. 
-If tranzation is died, rollback is execute.
-
-=head2 insert
-
-    # Insert
-    $dbi->insert($table, $insert_values);
-    
-    # Sample
-    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
-
-=head2 update
-
-    # Update
-    $dbi->update($table, $update_values, $where);
-    
-    # Sample
-    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
-
-=head2 update_all
-
-    # Update all rows
-    $dbi->update($table, $updat_values);
-
-=head2 delete
-
-    # Delete
-    $dbi->delete($table, $where);
-    
-    # Sample
-    $dbi->delete('Books', {id => 5});
-
-=head2 delete_all
-
-    # Delete all rows
-    $dbi->delete_all($table);
-
-=head2 last_insert_id
-
-    # Get last insert id
-    $last_insert_id = $dbi->last_insert_id;
-    
-This method is same as DBI last_insert_id;
-
-=head2 select
-    
-    # Select
-    $dbi->select(
-        $table,                # must be string or array;
-        [@$columns],           # must be array reference. this is optional
-        {%$where_params},      # must be hash reference.  this is optional
-        $append_statement,     # must be string.          this is optional
-        $query_edit_callback   # must be code reference.  this is optional
-    );
-    
-    # Sample
-    $dbi->select(
-        'Books',
-        ['title', 'author'],
-        {id => 1},
-        "for update",
-        sub {
-            my $query = shift;
-            $query->bind_filter(sub {
-                # ...
-            });
-        }
-    );
-    
-    # The way to join multi tables
-    $dbi->select(
-        ['table1', 'table2'],
-        ['table1.id as table1_id', 'title'],
-        {table1.id => 1},
-        "where table1.id = table2.id",
-    );
-
-=head1 Class Accessors
-
-=head2 query_cache_max
-
-    # Max query cache count
-    $class           = $class->query_cache_max($query_cache_max);
-    $query_cache_max = $class->query_cache_max;
-    
-    # Sample
-    DBIx::Custom->query_cache_max(50);
-
-=head1 CAUTION
-
-DBIx::Custom have DIB object internal.
-This module is work well in the following DBI condition.
-
-    1. AutoCommit is true
-    2. RaiseError is true
-
-By default, Both AutoCommit and RaiseError is true.
-You must not change these mode not to damage your data.
-
-If you change these mode, 
-you cannot get correct error message, 
-or run_transaction may fail.
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut

-117

DBIx-Custom-0.0501/blib/lib/DBIx/Custom/Basic.pm

View

@@ -1,117 +0,0 @@
-package DBIx::Custom::Basic;
-use 5.008001;
-use base 'DBIx::Custom';
-use Encode qw/decode encode/;
-
-use warnings;
-use strict;
-
-my $class = __PACKAGE__;
-
-$class->add_filter(
-    encode_utf8 => sub {
-        my $value = shift;
-        utf8::upgrade($value) unless Encode::is_utf8($value);
-        return encode('UTF-8', $value);
-    },
-    decode_utf8 => sub { decode('UTF-8', shift) }
-);
-
-$class->add_format(
-    'SQL99_date'        => '%Y-%m-%d',
-    'SQL99_datetime'    => '%Y-%m-%d %H:%M:%S',
-    'SQL99_time'        => '%H:%M:%S',
-    'ISO-8601_date'     => '%Y-%m-%d',
-    'ISO-8601_datetime' => '%Y-%m-%dT%H:%M:%S',
-    'ISO-8601_time'     => '%H:%M:%S',
-);
-
-# Methods
-sub utf8_filter_on {
-    my $self = shift;
-    $self->bind_filter($self->filters->{encode_utf8});
-    $self->fetch_filter($self->filters->{decode_utf8});
-}
-
-1;
-
-=head1 NAME
-
-DBIx::Custom::Basic - DBIx::Custom basic implementation
-
-=head1 Version
-
-Version 0.0201
-
-=head1 See DBIx::Custom documentation
-
-This class is L<DBIx::Custom> subclass.
-
-You can use all methods of L<DBIx::Custom>
-
-Please see L<DBIx::Custom> documentation
-
-=head1 Filters
-
-=head2 encode_utf8
-
-    # Encode to UTF-8 byte stream (utf8::upgrade is done if need)
-    $dbi->filters->{encode_utf8}->($value);
-    
-This filter is generally used as bind filter
-
-    $dbi->bind_filter($dbi->filters->{encode_utf8});
-
-=head2 decode_utf8
-
-    # Decode to perl internal string
-    $dbi->filters->{decode_utf8}->($value);
-    
-This filter is generally used as fetch filter
-
-    $dbi->fetch_filter($dbi->filters->{decode_utf8});
-
-=head2 Formats
-    
-strptime formats is available
-    
-    # format name        format
-    'SQL99_date'         '%Y-%m-%d',
-    'SQL99_datetime'     '%Y-%m-%d %H:%M:%S',
-    'SQL99_time'         '%H:%M:%S',
-    'ISO-8601_date'      '%Y-%m-%d',
-    'ISO-8601_datetime'  '%Y-%m-%dT%H:%M:%S',
-    'ISO-8601_time'      '%H:%M:%S',
-
-You get format as the following
-
-    my $format = $dbi->formats->{$format_name};
-
-=head1 Methods
-
-=head2 utf8_filter_on
-
-    # Encode and decode utf8 filter on
-    $dbi->utf8_filter_on;
-
-This equel to
-
-    $dbi->bind_filter($dbi->filters->{encode_utf8});
-    $dbi->fetch_filter($dbi->filters->{decode_utf8});
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut

-101

DBIx-Custom-0.0501/blib/lib/DBIx/Custom/Query.pm

View

@@ -1,101 +0,0 @@
-package DBIx::Custom::Query;
-use Object::Simple;
-
-sub sql             : Attr {}
-sub key_infos       : Attr {}
-sub bind_filter     : Attr {}
-sub fetch_filter     : Attr {}
-sub sth             : Attr {}
-
-sub no_bind_filters      : Attr { type => 'array', trigger => sub {
-    my $self = shift;
-    my $no_bind_filters = $self->no_bind_filters || [];
-    my %no_bind_filters_map = map {$_ => 1} @{$no_bind_filters};
-    $self->_no_bind_filters_map(\%no_bind_filters_map);
-}}
-sub _no_bind_filters_map : Attr {default => sub { {} }}
-
-sub no_fetch_filters     : Attr { type => 'array', default => sub { [] } }
-
-Object::Simple->build_class;
-
-=head1 NAME
-
-DBIx::Custom::Query - Query object for DBIx::Custom
-
-=head1 VERSION
-
-Version 0.0101
-
-=head1 SYNOPSIS
-
-    # Create query
-    my $dbi = DBIx::Custom->new;
-    my $query = $dbi->create_query($template);
-    
-    # Set query attributes
-    $query->bind_filter($dbi->filters->{default_bind_filter});
-    $query->no_bind_filters('title', 'author');
-    
-    $query->fetch_filter($dbi->filters->{default_fetch_filter});
-    $query->no_fetch_filters('title', 'author');
-    
-    # Execute query
-    $dbi->execute($query, $params);
-
-=head1 OBJECT ACCESSORS
-
-=head2 sth
-
-    # Set and get statement handle
-    $self = $query->sth($sql);
-    $sth  = $query->sth;
-
-=head2 sql
-
-    # Set and get SQL
-    $self = $query->sql($sql);
-    $sql  = $query->sql;
-
-=head2 bind_filter
-
-    # Set and get bind filter
-    $self        = $query->bind_filter($bind_filter);
-    $bind_filter = $query->bind_filter;
-
-=head2 no_bind_filters
-
-    # Set and get keys of no filtering
-    $self            = $query->no_bind_filters($no_filters);
-    $no_bind_filters = $query->no_bind_filters;
-
-=head2 fetch_filter
-
-    # Set and get fetch filter
-    $self        = $query->fetch_filter($fetch_filter);
-    $fetch_filter = $query->fetch_filter;
-
-=head2 no_fetch_filters
-
-    # Set and get keys of no filtering
-    $self            = $query->no_fetch_filters($no_filters);
-    $no_fetch_filters = $query->no_fetch_filters;
-
-=head2 key_infos
-
-    # Set and get key informations
-    $self      = $query->key_infos($key_infos);
-    $key_infos = $query->key_infos;
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.

-384

DBIx-Custom-0.0501/blib/lib/DBIx/Custom/Result.pm

View

@@ -1,384 +0,0 @@
-package DBIx::Custom::Result;
-use Object::Simple;
-use strict;
-use warnings;
-use Carp 'croak';
-
-# Attributes
-sub sth              : Attr {}
-sub fetch_filter     : Attr {}
-sub no_fetch_filters      : Attr { type => 'array', trigger => sub {
-    my $self = shift;
-    my $no_fetch_filters = $self->no_fetch_filters || [];
-    my %no_fetch_filters_map = map {$_ => 1} @{$no_fetch_filters};
-    $self->_no_fetch_filters_map(\%no_fetch_filters_map);
-}}
-sub _no_fetch_filters_map : Attr {default => sub { {} }}
-
-# Fetch (array)
-sub fetch {
-    my ($self, $type) = @_;
-    my $sth = $self->sth;
-    my $fetch_filter = $self->fetch_filter;
-    
-    # Fetch
-    my $row = $sth->fetchrow_arrayref;
-    
-    # Cannot fetch
-    return unless $row;
-    
-    # Filter
-    if ($fetch_filter) {
-        my $keys  = $sth->{NAME_lc};
-        my $types = $sth->{TYPE};
-        for (my $i = 0; $i < @$keys; $i++) {
-            next if $self->_no_fetch_filters_map->{$keys->[$i]};
-            $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $types->[$i],
-                                        $sth, $i);
-        }
-    }
-    return wantarray ? @$row : $row;
-}
-
-# Fetch (hash)
-sub fetch_hash {
-    my $self = shift;
-    my $sth = $self->sth;
-    my $fetch_filter = $self->fetch_filter;
-    
-    # Fetch
-    my $row = $sth->fetchrow_arrayref;
-    
-    # Cannot fetch
-    return unless $row;
-    
-    # Keys
-    my $keys  = $sth->{NAME_lc};
-    
-    # Filter
-    my $row_hash = {};
-    if ($fetch_filter) {
-        my $types = $sth->{TYPE};
-        for (my $i = 0; $i < @$keys; $i++) {
-            if ($self->_no_fetch_filters_map->{$keys->[$i]}) {
-                $row_hash->{$keys->[$i]} = $row->[$i];
-            }
-            else {
-                $row_hash->{$keys->[$i]}
-                  = $fetch_filter->($row->[$i], $keys->[$i],
-                                    $types->[$i], $sth, $i);
-            }
-        }
-    }
-    
-    # No filter
-    else {
-        for (my $i = 0; $i < @$keys; $i++) {
-            $row_hash->{$keys->[$i]} = $row->[$i];
-        }
-    }
-    return wantarray ? %$row_hash : $row_hash;
-}
-
-# Fetch only first (array)
-sub fetch_first {
-    my $self = shift;
-    
-    # Fetch
-    my $row = $self->fetch;
-    
-    # Not exist
-    return unless $row;
-    
-    # Finish statement handle
-    $self->finish;
-    
-    return wantarray ? @$row : $row;
-}
-
-# Fetch only first (hash)
-sub fetch_hash_first {
-    my $self = shift;
-    
-    # Fetch hash
-    my $row = $self->fetch_hash;
-    
-    # Not exist
-    return unless $row;
-    
-    # Finish statement handle
-    $self->finish;
-    
-    return wantarray ? %$row : $row;
-}
-
-# Fetch multi rows (array)
-sub fetch_rows {
-    my ($self, $count) = @_;
-    
-    # Not specified Row count
-    croak("Row count must be specified")
-      unless $count;
-    
-    # Fetch multi rows
-    my $rows = [];
-    for (my $i = 0; $i < $count; $i++) {
-        my @row = $self->fetch;
-        
-        last unless @row;
-        
-        push @$rows, \@row;
-    }
-    
-    return unless @$rows;
-    return wantarray ? @$rows : $rows;
-}
-
-# Fetch multi rows (hash)
-sub fetch_hash_rows {
-    my ($self, $count) = @_;
-    
-    # Not specified Row count
-    croak("Row count must be specified")
-      unless $count;
-    
-    # Fetch multi rows
-    my $rows = [];
-    for (my $i = 0; $i < $count; $i++) {
-        my %row = $self->fetch_hash;
-        
-        last unless %row;
-        
-        push @$rows, \%row;
-    }
-    
-    return unless @$rows;
-    return wantarray ? @$rows : $rows;
-}
-
-
-# Fetch all (array)
-sub fetch_all {
-    my $self = shift;
-    
-    my $rows = [];
-    while(my @row = $self->fetch) {
-        push @$rows, [@row];
-    }
-    return wantarray ? @$rows : $rows;
-}
-
-# Fetch all (hash)
-sub fetch_hash_all {
-    my $self = shift;
-    
-    my $rows = [];
-    while(my %row = $self->fetch_hash) {
-        push @$rows, {%row};
-    }
-    return wantarray ? @$rows : $rows;
-}
-
-# Finish
-sub finish { shift->sth->finish }
-
-# Error
-sub error { 
-    my $self = shift;
-    my $sth  = $self->sth;
-    return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr;
-}
-
-Object::Simple->build_class;
-
-=head1 NAME
-
-DBIx::Custom::Result - Resultset for DBIx::Custom
-
-=head1 VERSION
-
-Version 0.0301
-
-=head1 SYNOPSIS
-
-    # $result is DBIx::Custom::Result object
-    my $dbi = DBIx::Custom->new;
-    my $result = $dbi->query($sql_template, $param);
-    
-    while (my ($val1, $val2) = $result->fetch) {
-        # do something
-    }
-
-=head1 OBJECT ACCESSORS
-
-=head2 sth
-
-    # Set and Get statement handle
-    $self = $result->sth($sth);
-    $sth  = $reuslt->sth
-
-Statement handle is automatically set by DBIx::Custom.
-so you do not set statement handle.
-
-If you need statement handle, you can get statement handle by using this method.
-
-=head2 fetch_filter
-
-    # Set and Get fetch filter
-    $self         = $result->fetch_filter($sth);
-    $fetch_filter = $result->fech_filter;
-
-Statement handle is automatically set by DBIx::Custom.
-If you want to set your fetch filter, you set it.
-
-=head2 no_fetch_filters
-
-    # Set and Get no filter keys when fetching
-    $self             = $result->no_fetch_filters($no_fetch_filters);
-    $no_fetch_filters = $result->no_fetch_filters;
-
-=head1 METHODS
-
-=head2 fetch
-
-    # Fetch row as array reference (Scalar context)
-    $row = $result->fetch;
-    
-    # Fetch row as array (List context)
-    @row = $result->fecth
-
-    # Sample
-    while (my $row = $result->fetch) {
-        # do something
-        my $val1 = $row->[0];
-        my $val2 = $row->[1];
-    }
-
-fetch method is fetch resultset and get row as array or array reference.
-
-=head2 fetch_hash
-
-    # Fetch row as hash reference (Scalar context)
-    $row = $result->fetch_hash;
-    
-    # Fetch row as hash (List context)
-    %row = $result->fecth_hash
-
-    # Sample
-    while (my $row = $result->fetch_hash) {
-        # do something
-        my $val1 = $row->{key1};
-        my $val2 = $row->{key2};
-    }
-
-fetch_hash method is fetch resultset and get row as hash or hash reference.
-
-=head2 fetch_first
-
-    # Fetch only first (Scalar context)
-    $row = $result->fetch_first;
-    
-    # Fetch only first (List context)
-    @row = $result->fetch_first;
-    
-This method fetch only first and finish statement handle
-
-=head2 fetch_hash_first
-    
-    # Fetch only first as hash (Scalar context)
-    $row = $result->fetch_hash_first;
-    
-    # Fetch only first as hash (Scalar context)
-    @row = $result->fetch_hash_first;
-    
-This method fetch only first and finish statement handle
-
-=head2 fetch_rows
-
-    # Fetch multi rows (Scalar context)
-    $rows = $result->fetch_rows($row_count);
-    
-    # Fetch multi rows (List context)
-    @rows = $result->fetch_rows($row_count);
-    
-    # Sapmle 
-    $rows = $result->fetch_rows(10);
-
-=head2 fetch_hash_rows
-
-    # Fetch multi rows as hash (Scalar context)
-    $rows = $result->fetch_hash_rows($row_count);
-    
-    # Fetch multi rows as hash (List context)
-    @rows = $result->fetch_hash_rows($row_count);
-    
-    # Sapmle 
-    $rows = $result->fetch_hash_rows(10);
-
-=head2 fetch_all
-
-    # Fetch all row as array ref of array ref (Scalar context)
-    $rows = $result->fetch_all;
-    
-    # Fetch all row as array of array ref (List context)
-    @rows = $result->fecth_all;
-
-    # Sample
-    my $rows = $result->fetch_all;
-    my $val0_0 = $rows->[0][0];
-    my $val1_1 = $rows->[1][1];
-
-fetch_all method is fetch resultset and get all rows as array or array reference.
-
-=head2 fetch_hash_all
-
-    # Fetch all row as array ref of hash ref (Scalar context)
-    $rows = $result->fetch_hash_all;
-    
-    # Fetch all row as array of hash ref (List context)
-    @rows = $result->fecth_all_hash;
-
-    # Sample
-    my $rows = $result->fetch_hash_all;
-    my $val0_key1 = $rows->[0]{key1};
-    my $val1_key2 = $rows->[1]{key2};
-
-=head2 error
-
-    # Get error infomation
-    $error_messege = $result->error;
-    ($error_message, $error_number, $error_state) = $result->error;
-
-You can get get information. This is crenspond to the following.
-
-    $error_message : $result->sth->errstr
-    $error_number  : $result->sth->err
-    $error_state   : $result->sth->state
-
-=head2 finish
-
-    # Finish statement handle
-    $result->finish
-    
-    # Sample
-    my $row = $reuslt->fetch; # fetch only one row
-    $result->finish
-
-You can finish statement handle.This is equel to
-
-    $result->sth->finish;
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut

-694

DBIx-Custom-0.0501/blib/lib/DBIx/Custom/SQL/Template.pm

View

@@ -1,694 +0,0 @@
-package DBIx::Custom::SQL::Template;
-use Object::Simple;
-
-use Carp 'croak';
-
-# Accessor is created by Object::Simple. Please read Object::Simple document
-
-### Class-Object accessors
-
-# Tag start
-sub tag_start   : ClassObjectAttr {
-    initialize => {default => '{', clone => 'scalar'}
-}
-
-# Tag end
-sub tag_end     : ClassObjectAttr {
-    initialize => {default => '}', clone => 'scalar'}
-}
-
-# Tag syntax
-sub tag_syntax  : ClassObjectAttr {
-    initialize => {default => <<'EOS', clone => 'scalar'}}
-[tag]                     [expand]
-{? name}                  ?
-{= name}                  name = ?
-{<> name}                 name <> ?
-
-{< name}                  name < ?
-{> name}                  name > ?
-{>= name}                 name >= ?
-{<= name}                 name <= ?
-
-{like name}               name like ?
-{in name number}          name in [?, ?, ..]
-
-{insert key1 key2} (key1, key2) values (?, ?)
-{update key1 key2}    set key1 = ?, key2 = ?
-EOS
-
-# Tag processors
-sub tag_processors : ClassObjectAttr {
-    type => 'hash',
-    deref => 1,
-    initialize => {
-        clone => 'hash', 
-        default => sub {{
-            '?'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '='             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '<>'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '>'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '<'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '>='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '<='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            'like'          => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            'in'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_in_tag,
-            'insert'        => \&DBIx::Custom::SQL::Template::TagProcessor::expand_insert_tag,
-            'update'    => \&DBIx::Custom::SQL::Template::TagProcessor::expand_update_tag
-        }}
-    }
-}
-
-# Add Tag processor
-sub add_tag_processor {
-    my $invocant = shift;
-    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
-    $invocant->tag_processors(%{$invocant->tag_processors}, %{$tag_processors});
-    return $invocant;
-}
-
-# Clone
-sub clone {
-    my $self = shift;
-    my $new = $self->new;
-    
-    $new->tag_start($self->tag_start);
-    $new->tag_end($self->tag_end);
-    $new->tag_syntax($self->tag_syntax);
-    $new->tag_processors({%{$self->tag_processors || {}}});
-    
-    return $new;
-}
-
-
-### Object Methods
-
-# Create Query
-sub create_query {
-    my ($self, $template)  = @_;
-    
-    # Parse template
-    my $tree = $self->_parse_template($template);
-    
-    # Build query
-    my $query = $self->_build_query($tree);
-    
-    return $query;
-}
-
-# Parse template
-sub _parse_template {
-    my ($self, $template) = @_;
-    $template ||= '';
-    
-    my $tree = [];
-    
-    # Tags
-    my $tag_start = quotemeta $self->tag_start;
-    my $tag_end   = quotemeta $self->tag_end;
-    
-    # Tokenize
-    my $state = 'text';
-    
-    # Save original template
-    my $original_template = $template;
-    
-    # Parse template
-    while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {
-        my $text = $1;
-        my $tag  = $2;
-        
-        # Parse tree
-        push @$tree, {type => 'text', tag_args => [$text]} if $text;
-        
-        if ($tag) {
-            # Get tag name and arguments
-            my ($tag_name, @tag_args) = split /\s+/, $tag;
-            
-            # Tag processor is exist?
-            unless ($self->tag_processors->{$tag_name}) {
-                my $tag_syntax = $self->tag_syntax;
-                croak("Tag '{$tag}' in SQL template is not exist.\n\n" .
-                      "<SQL template tag syntax>\n" .
-                      "$tag_syntax\n" .
-                      "<Your SQL template>\n" .
-                      "$original_template\n\n");
-            }
-            
-            # Check tag arguments
-            foreach my $tag_arg (@tag_args) {
-                # Cannot cantain placehosder '?'
-                croak("Tag '{t }' arguments cannot contain '?'")
-                  if $tag_arg =~ /\?/;
-            }
-            
-            # Add tag to parsing tree
-            push @$tree, {type => 'tag', tag_name => $tag_name, tag_args => [@tag_args]};
-        }
-    }
-    
-    # Add text to parsing tree 
-    push @$tree, {type => 'text', tag_args => [$template]} if $template;
-    
-    return $tree;
-}
-
-# Build SQL from parsing tree
-sub _build_query {
-    my ($self, $tree) = @_;
-    
-    # SQL
-    my $sql = '';
-    
-    # All parameter key infomation
-    my $all_key_infos = [];
-    
-    # Build SQL 
-    foreach my $node (@$tree) {
-        
-        # Get type, tag name, and arguments
-        my $type     = $node->{type};
-        my $tag_name = $node->{tag_name};
-        my $tag_args = $node->{tag_args};
-        
-        # Text
-        if ($type eq 'text') {
-            # Join text
-            $sql .= $tag_args->[0];
-        }
-        
-        # Tag
-        elsif ($type eq 'tag') {
-            
-            # Get tag processor
-            my $tag_processor = $self->tag_processors->{$tag_name};
-            
-            # Tag processor is code ref?
-            croak("Tag processor '$tag_name' must be code reference")
-              unless ref $tag_processor eq 'CODE';
-            
-            # Expand tag using tag processor
-            my ($expand, $key_infos)
-              = $tag_processor->($tag_name, $tag_args);
-            
-            # Check tag processor return value
-            croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)")
-              if !defined $expand || ref $key_infos ne 'ARRAY';
-            
-            # Check placeholder count
-            croak("Placeholder count in SQL created by tag processor '$tag_name' " .
-                  "must be same as key informations count")
-              unless $self->_placeholder_count($expand) eq @$key_infos;
-            
-            # Add key information
-            push @$all_key_infos, @$key_infos;
-            
-            # Join expand tag to SQL
-            $sql .= $expand;
-        }
-    }
-    
-    # Add semicolon
-    $sql .= ';' unless $sql =~ /;$/;
-    
-    # Query
-    my $query = {sql => $sql, key_infos => $all_key_infos};
-    
-    return $query;
-}
-
-# Get placeholder count
-sub _placeholder_count {
-    my ($self, $expand) = @_;
-    $expand ||= '';
-    
-    my $count = 0;
-    my $pos   = -1;
-    while (($pos = index($expand, '?', $pos + 1)) != -1) {
-        $count++;
-    }
-    return $count;
-}
-
-Object::Simple->build_class;
-
-
-package DBIx::Custom::SQL::Template::TagProcessor;
-use strict;
-use warnings;
-use Carp 'croak';
-
-# Expand tag '?', '=', '<>', '>', '<', '>=', '<=', 'like'
-sub expand_basic_tag {
-    my ($tag_name, $tag_args) = @_;
-    my $original_key = $tag_args->[0];
-    
-    # Key is not exist
-    croak("You must be pass key as argument to tag '{$tag_name }'")
-      if !$original_key;
-    
-    # Expanded tag
-    my $expand = $tag_name eq '?'
-               ? '?'
-               : "$original_key $tag_name ?";
-    
-    # Get table and clumn name
-    my ($table, $column) = get_table_and_column($original_key);
-    
-    # Parameter key infomation
-    my $key_info = {};
-    
-    # Original key
-    $key_info->{original_key} = $original_key;
-    
-    # Table
-    $key_info->{table}  = $table;
-    
-    # Column name
-    $key_info->{column} = $column;
-    
-    # Access keys
-    my $access_keys = [];
-    push @$access_keys, [$original_key];
-    push @$access_keys, [$table, $column] if $table && $column;
-    $key_info->{access_keys} = $access_keys;
-    
-    # Add parameter key information
-    my $key_infos = [];
-    push @$key_infos, $key_info;
-    
-    return ($expand, $key_infos);
-}
-
-# Expand tag 'in'
-sub expand_in_tag {
-    my ($tag_name, $tag_args) = @_;
-    my ($original_key, $placeholder_count) = @$tag_args;
-    
-    # Key must be specified
-    croak("You must be pass key as first argument of tag '{$tag_name }'\n" . 
-          "Usage: {$tag_name \$key \$placeholder_count}")
-      unless $original_key;
-      
-    
-    # Place holder count must be specified
-    croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" . 
-          "Usage: {$tag_name \$key \$placeholder_count}")
-      if !$placeholder_count || $placeholder_count =~ /\D/;
-
-    # Expand tag
-    my $expand = "$original_key $tag_name (";
-    for (my $i = 0; $i < $placeholder_count; $i++) {
-        $expand .= '?, ';
-    }
-    
-    $expand =~ s/, $//;
-    $expand .= ')';
-    
-    # Get table and clumn name
-    my ($table, $column) = get_table_and_column($original_key);
-    
-    # Create parameter key infomations
-    my $key_infos = [];
-    for (my $i = 0; $i < $placeholder_count; $i++) {
-        # Parameter key infomation
-        my $key_info = {};
-        
-        # Original key
-        $key_info->{original_key} = $original_key;
-        
-        # Table
-        $key_info->{table}   = $table;
-        
-        # Column name
-        $key_info->{column}  = $column;
-        
-        # Access keys
-        my $access_keys = [];
-        push @$access_keys, [$original_key, [$i]];
-        push @$access_keys, [$table, $column, [$i]] if $table && $column;
-        $key_info->{access_keys} = $access_keys;
-        
-        # Add parameter key infos
-        push @$key_infos, $key_info;
-    }
-    
-    return ($expand, $key_infos);
-}
-
-# Get table and column
-sub get_table_and_column {
-    my $key = shift;
-    $key ||= '';
-    
-    return ('', $key) unless $key =~ /\./;
-    
-    my ($table, $column) = split /\./, $key;
-    
-    return ($table, $column);
-}
-
-# Expand tag 'insert'
-sub expand_insert_tag {
-    my ($tag_name, $tag_args) = @_;
-    my $original_keys = $tag_args;
-    
-    # Insert key (k1, k2, k3, ..)
-    my $insert_keys = '(';
-    
-    # placeholder (?, ?, ?, ..)
-    my $place_holders = '(';
-    
-    foreach my $original_key (@$original_keys) {
-        # Get table and column
-        my ($table, $column) = get_table_and_column($original_key);
-        
-        # Join insert column
-        $insert_keys   .= "$column, ";
-        
-        # Join place holder
-        $place_holders .= "?, ";
-    }
-    
-    # Delete last ', '
-    $insert_keys =~ s/, $//;
-    
-    # Close 
-    $insert_keys .= ')';
-    $place_holders =~ s/, $//;
-    $place_holders .= ')';
-    
-    # Expand tag
-    my $expand = "$insert_keys values $place_holders";
-    
-    # Create parameter key infomations
-    my $key_infos = [];
-    foreach my $original_key (@$original_keys) {
-        # Get table and clumn name
-        my ($table, $column) = get_table_and_column($original_key);
-        
-        # Parameter key infomation
-        my $key_info = {};
-        
-        # Original key
-        $key_info->{original_key} = $original_key;
-        
-        # Table
-        $key_info->{table}   = $table;
-        
-        # Column name
-        $key_info->{column}  = $column;
-        
-        # Access keys
-        my $access_keys = [];
-        push @$access_keys, ['#insert', $original_key];
-        push @$access_keys, ['#insert', $table, $column] if $table && $column;
-        push @$access_keys, [$original_key];
-        push @$access_keys, [$table, $column] if $table && $column;
-        $key_info->{access_keys} = $access_keys;
-        
-        # Add parameter key infos
-        push @$key_infos, $key_info;
-    }
-    
-    return ($expand, $key_infos);
-}
-
-# Expand tag 'update'
-sub expand_update_tag {
-    my ($tag_name, $tag_args) = @_;
-    my $original_keys = $tag_args;
-    
-    # Expanded tag
-    my $expand = 'set ';
-    
-    # 
-    foreach my $original_key (@$original_keys) {
-        # Get table and clumn name
-        my ($table, $column) = get_table_and_column($original_key);
-
-        # Join key and placeholder
-        $expand .= "$column = ?, ";
-    }
-    
-    # Delete last ', '
-    $expand =~ s/, $//;
-    
-    # Create parameter key infomations
-    my $key_infos = [];
-    foreach my $original_key (@$original_keys) {
-        # Get table and clumn name
-        my ($table, $column) = get_table_and_column($original_key);
-        
-        # Parameter key infomation
-        my $key_info = {};
-        
-        # Original key
-        $key_info->{original_key} = $original_key;
-        
-        # Table
-        $key_info->{table}  = $table;
-        
-        # Column name
-        $key_info->{column} = $column;
-        
-        # Access keys
-        my $access_keys = [];
-        push @$access_keys, ['#update', $original_key];
-        push @$access_keys, ['#update', $table, $column] if $table && $column;
-        push @$access_keys, [$original_key];
-        push @$access_keys, [$table, $column] if $table && $column;
-        $key_info->{access_keys} = $access_keys;
-        
-        # Add parameter key infos
-        push @$key_infos, $key_info;
-    }
-    
-    return ($expand, $key_infos);
-}
-
-1;
-
-=head1 NAME
-
-DBIx::Custom::SQL::Template - Custamizable SQL Template for DBIx::Custom
-
-=head1 VERSION
-
-Version 0.0101
-
-=cut
-
-=head1 SYNOPSIS
-    
-    my $sql_tmpl = DBIx::Custom::SQL::Template->new;
-    
-    my $tmpl   = "select from table {= k1} && {<> k2} || {like k3}";
-    my $param = {k1 => 1, k2 => 2, k3 => 3};
-    
-    my $query = $sql_template->create_query($tmpl);
-    
-    
-    # Using query from DBIx::Custom
-    use DBIx::Custom;
-    my $dbi = DBI->new(
-       data_source => $data_source,
-       user        => $user,
-       password    => $password, 
-       dbi_options => {PrintError => 0, RaiseError => 1}
-    );
-    
-    $query = $dbi->create_query($tmpl); # This is SQL::Template create_query
-    $dbi->query($query, $param);
-
-=head1 CLASS-OBJECT ACCESSORS
-
-Class-Object accessor is used from both object and class
-
-    $class->$accessor # call from class
-    $self->$accessor  # call form object
-
-=head2 tag_processors
-
-    # Set and get
-    $self           = $sql_tmpl->tag_processors($tag_processors);
-    $tag_processors = $sql_tmpl->tag_processors;
-    
-    # Sample
-    $sql_tmpl->tag_processors(
-        '?' => \&expand_question,
-        '=' => \&expand_equel
-    );
-
-You can use add_tag_processor to add tag processor
-
-=head2 tag_start
-
-    # Set and get
-    $self      = $sql_tmpl->tag_start($tag_start);
-    $tag_start = $sql_tmpl->tag_start;
-    
-    # Sample
-    $sql_tmpl->tag_start('{');
-
-Default is '{'
-
-=head2 tag_end
-
-    # Set and get
-    $self    = $sql_tmpl->tag_start($tag_end);
-    $tag_end = $sql_tmpl->tag_start;
-    
-    # Sample
-    $sql_tmpl->tag_start('}');
-
-Default is '}'
-    
-=head2 tag_syntax
-    
-    # Set and get
-    $self       = $sql_tmpl->tag_syntax($tag_syntax);
-    $tag_syntax = $sql_tmpl->tag_syntax;
-    
-    # Sample
-    $sql_tmpl->tag_syntax(
-        "[Tag]            [Expand]\n" .
-        "{? name}         ?\n" .
-        "{= name}         name = ?\n" .
-        "{<> name}        name <> ?\n"
-    );
-
-=head1 METHODS
-
-=head2 create_query
-    
-    # Create SQL form SQL template
-    $query = $sql_tmpl->create_query($tmpl);
-    
-    # Sample
-    $query = $sql_tmpl->create_sql(
-         "select * from table where {= title} && {like author} || {<= price}")
-    
-    # Result
-    $qeury->{sql} : "select * from table where title = ? && author like ? price <= ?;"
-    $query->{key_infos} : [['title'], ['author'], ['price']]
-    
-    # Sample2 (with table name)
-    ($sql, @bind_values) = $sql_tmpl->create_sql(
-            "select * from table where {= table.title} && {like table.author}",
-            {table => {title => 'Perl', author => '%Taro%'}}
-        )
-    
-    # Result2
-    $query->{sql} : "select * from table where table.title = ? && table.title like ?;"
-    $query->{key_infos} :[ [['table.title'],['table', 'title']],
-                           [['table.author'],['table', 'author']] ]
-
-This method create query using by DBIx::Custom.
-query is two infomation
-
-    1.sql       : SQL
-    2.key_infos : Parameter access key information
-
-=head2 add_tag_processor
-
-Add tag processor
-  
-    # Add
-    $self = $sql_tmpl->add_tag_processor($tag_processor);
-    
-    # Sample
-    $sql_tmpl->add_tag_processor(
-        '?' => sub {
-            my ($tag_name, $tag_args) = @_;
-            
-            my $key1 = $tag_args->[0];
-            my $key2 = $tag_args->[1];
-            
-            my $key_infos = [];
-            
-            # Expand tag and create key informations
-            
-            # Return expand tags and key informations
-            return ($expand, $key_infos);
-        }
-    );
-
-Tag processor recieve 2 argument
-
-    1. Tag name            (?, =, <>, or etc)
-    2. Tag arguments       (arg1 and arg2 in {tag_name arg1 arg2})
-
-Tag processor return 2 value
-
-    1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?')
-    2. Key infomations
-    
-You must be return expanded tag and key infomations.
-
-Key information is a little complex. so I will explan this in future.
-
-If you want to know more, Please see DBIx::Custom::SQL::Template source code.
-
-=head2 clone
-
-    # Clone DBIx::Custom::SQL::Template object
-    $clone = $self->clone;
-    
-=head1 Available Tags
-    
-    # Available Tags
-    [tag]            [expand]
-    {? name}         ?
-    {= name}         name = ?
-    {<> name}        name <> ?
-    
-    {< name}         name < ?
-    {> name}         name > ?
-    {>= name}        name >= ?
-    {<= name}        name <= ?
-    
-    {like name}      name like ?
-    {in name}        name in [?, ?, ..]
-    
-    {insert}  (key1, key2, key3) values (?, ?, ?)
-    {update}     set key1 = ?, key2 = ?, key3 = ?
-    
-    # Sample1
-    $query = $sql_tmpl->create_sql(
-        "insert into table {insert key1 key2}"
-    );
-    # Result1
-    $sql : "insert into table (key1, key2) values (?, ?)"
-    
-    
-    # Sample2
-    $query = $sql_tmpl->create_sql(
-        "update table {update key1 key2} where {= key3}"
-    );
-    
-    # Result2
-    $query->{sql} : "update table set key1 = ?, key2 = ? where key3 = ?;"
-    
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github 
-L<http://github.com/yuki-kimoto>
-L<http://github.com/yuki-kimoto/DBIx-Custom-SQL-Template>
-
-Please let know me bag if you find
-Please request me if you want to do something
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-
-=cut
-
-1; # End of DBIx::Custom::SQL::Template

-136

DBIx-Custom-0.0501/blib/lib/DBIx/Custom/SQLite.pm

View

@@ -1,136 +0,0 @@
-package DBIx::Custom::SQLite;
-use base 'DBIx::Custom::Basic';
-
-use warnings;
-use strict;
-use Carp 'croak';
-
-my $class = __PACKAGE__;
-
-$class->add_format(
-    datetime => $class->formats->{SQL99_datetime},
-    date     => $class->formats->{SQL99_date},
-    time     => $class->formats->{SQL99_time},
-);
-
-sub connect {
-    my $self = shift;
-    
-    if (!$self->data_source && (my $database = $self->database)) {
-        $self->data_source("dbi:SQLite:dbname=$database");
-    }
-    
-    return $self->SUPER::connect;
-}
-
-sub connect_memory {
-    my $self = shift;
-    
-    # Data source for memory database
-    $self->data_source('dbi:SQLite:dbname=:memory:');
-    
-    # Already connected
-    croak("Already connected") if $self->connected;
-    
-    # Connect
-    $self->connect;
-    
-    return $self;
-}
-
-sub reconnect_memory {
-    my $self = shift;
-
-    # Data source for memory database
-    $self->data_source('dbi:SQLite:dbname=:memory:');
-    
-    # Reconnect
-    $self->reconnect;
-    
-    return $self;
-}
-
-
-=head1 NAME
-
-DBIx::Custom::SQLite - DBIx::Custom SQLite implementation
-
-=head1 Version
-
-Version 0.0201
-
-=head1 Synopsys
-
-    use DBIx::Custom::SQLite;
-    
-    # New
-    my $dbi = DBIx::Custom::SQLite->new(user => 'taro', $password => 'kliej&@K',
-                                       database => 'sample.db');
-    
-    # Insert 
-    $dbi->insert('books', {title => 'perl', author => 'taro'});
-    
-    # Update 
-    # same as 'update books set (title = 'aaa', author = 'ken') where id = 5;
-    $dbi->update('books', {title => 'aaa', author => 'ken'}, {id => 5});
-    
-    # Delete
-    $dbi->delete('books', {author => 'taro'});
-    
-    # select * from books;
-    $dbi->select('books');
-    
-    # select * from books where ahthor = 'taro'; 
-    $dbi->select('books', {author => 'taro'}); 
-    
-    # select author, title from books where author = 'taro'
-    $dbi->select('books', [qw/author title/], {author => 'taro'});
-    
-    # select author, title from books where author = 'taro' order by id limit 1;
-    $dbi->select('books', [qw/author title/], {author => 'taro'},
-                 'order by id limit 1');
-
-=head1 See DBIx::Custom and DBI::Custom::Basic documentation
-
-This class is L<DBIx::Custom::Basic> subclass.
-and L<DBIx::Custom::Basic> is L<DBIx::Custom> subclass
-
-You can use all methods of L<DBIx::Custom::Basic> and <DBIx::Custom>
-Please see L<DBIx::Custom::Basic> and <DBIx::Custom> documentation
-
-=head1 Object methods
-
-=head2 connect
-
-This override L<DBIx::Custom> connect.
-
-    # Connect to database
-    $dbi->connect;
-
-If database attribute is set, automatically data source is created and connect
-
-=head2 connect_memory
-
-    # Connect memory database
-    $self = $dbi->connect_memory;
-
-=head2 reconnect_memory
-
-    # Reconnect memory database
-    $self = $dbi->reconnect_memory;
-
-=head1 Author
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
-
-=head1 Copyright & lisence
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-599

DBIx-Custom-0.0501/blib/libdoc/DBIx::Custom.3pm

View

@@ -1,599 +0,0 @@
-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sh \" Subsection heading
-.br
-.if t .Sp
-.ne 5
-.PP
-\fB\\$1\fR
-.PP
-..
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings.  \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote.  | will give a
-.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
-.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
-.\" expand to `' in nroff, nothing in troff, for use with C<>.
-.tr \(*W-|\(bv\*(Tr
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-.    ds -- \(*W-
-.    ds PI pi
-.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
-.    ds L" ""
-.    ds R" ""
-.    ds C` ""
-.    ds C' ""
-'br\}
-.el\{\
-.    ds -- \|\(em\|
-.    ds PI \(*p
-.    ds L" ``
-.    ds R" ''
-'br\}
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
-.\" entries marked with X<> in POD.  Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.if \nF \{\
-.    de IX
-.    tm Index:\\$1\t\\n%\t"\\$2"
-..
-.    nr % 0
-.    rr F
-.\}
-.\"
-.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.hy 0
-.if n .na
-.\"
-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
-.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
-.    \" fudge factors for nroff and troff
-.if n \{\
-.    ds #H 0
-.    ds #V .8m
-.    ds #F .3m
-.    ds #[ \f1
-.    ds #] \fP
-.\}
-.if t \{\
-.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
-.    ds #V .6m
-.    ds #F 0
-.    ds #[ \&
-.    ds #] \&
-.\}
-.    \" simple accents for nroff and troff
-.if n \{\
-.    ds ' \&
-.    ds ` \&
-.    ds ^ \&
-.    ds , \&
-.    ds ~ ~
-.    ds /
-.\}
-.if t \{\
-.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
-.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
-.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
-.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
-.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
-.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
-.\}
-.    \" troff and (daisy-wheel) nroff accents
-.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
-.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
-.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
-.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
-.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
-.ds ae a\h'-(\w'a'u*4/10)'e
-.ds Ae A\h'-(\w'A'u*4/10)'E
-.    \" corrections for vroff
-.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
-.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
-.    \" for low resolution devices (crt and lpr)
-.if \n(.H>23 .if \n(.V>19 \
-\{\
-.    ds : e
-.    ds 8 ss
-.    ds o a
-.    ds d- d\h'-1'\(ga
-.    ds D- D\h'-1'\(hy
-.    ds th \o'bp'
-.    ds Th \o'LP'
-.    ds ae ae
-.    ds Ae AE
-.\}
-.rm #[ #] #H #V #F C
-.\" ========================================================================
-.\"
-.IX Title "DBIx::Custom 3"
-.TH DBIx::Custom 3 "2009-11-16" "perl v5.8.8" "User Contributed Perl Documentation"
-.SH "NAME"
-DBIx::Custom \- Customizable simple DBI
-.SH "VERSION"
-.IX Header "VERSION"
-Version 0.0501
-.SH "CAUTION"
-.IX Header "CAUTION"
-This module is now experimental stage.
-.PP
-I want you to try this module
-because I want this module stable, and not to damage your \s-1DB\s0 data by this module bug.
-.PP
-Please tell me bug if you find
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\&  my $dbi = DBIx::Custom->new;
-.Ve
-.PP
-.Vb 2
-\&  my $query = $dbi->create_query($template);
-\&  $dbi->execute($query);
-.Ve
-.SH "CLASS-OBJECT ACCESSORS"
-.IX Header "CLASS-OBJECT ACCESSORS"
-.Sh "user"
-.IX Subsection "user"
-.Vb 3
-\&    # Set and get database user name
-\&    $self = $dbi->user($user);
-\&    $user = $dbi->user;
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->user('taro');
-.Ve
-.Sh "password"
-.IX Subsection "password"
-.Vb 3
-\&    # Set and get database password
-\&    $self     = $dbi->password($password);
-\&    $password = $dbi->password;
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->password('lkj&le`@s');
-.Ve
-.Sh "data_source"
-.IX Subsection "data_source"
-.Vb 3
-\&    # Set and get database data source
-\&    $self        = $dbi->data_source($data_soruce);
-\&    $data_source = $dbi->data_source;
-.Ve
-.PP
-.Vb 2
-\&    # Sample(SQLite)
-\&    $dbi->data_source(dbi:SQLite:dbname=$database);
-.Ve
-.PP
-.Vb 2
-\&    # Sample(MySQL);
-\&    $dbi->data_source("dbi:mysql:dbname=$database");
-.Ve
-.PP
-.Vb 2
-\&    # Sample(PostgreSQL)
-\&    $dbi->data_source("dbi:Pg:dbname=$database");
-.Ve
-.Sh "database"
-.IX Subsection "database"
-.Vb 3
-\&    # Set and get database name
-\&    $self     = $dbi->database($database);
-\&    $database = $dbi->database;
-.Ve
-.PP
-This method will be used in subclass connect method.
-.Sh "dbi_options"
-.IX Subsection "dbi_options"
-.Vb 3
-\&    # Set and get DBI option
-\&    $self       = $dbi->dbi_options({$options => $value, ...});
-\&    $dbi_options = $dbi->dbi_options;
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
-.Ve
-.PP
-dbi_options is used when you connect database by using connect.
-.Sh "prepare"
-.IX Subsection "prepare"
-.Vb 1
-\&    $sth = $dbi->prepare($sql);
-.Ve
-.PP
-This method is same as DBI::prepare
-.Sh "do"
-.IX Subsection "do"
-.Vb 1
-\&    $dbi->do($sql, @bind_values);
-.Ve
-.PP
-This method is same as DBI::do
-.Sh "sql_template"
-.IX Subsection "sql_template"
-.Vb 3
-\&    # Set and get SQL::Template object
-\&    $self         = $dbi->sql_template($sql_template);
-\&    $sql_template = $dbi->sql_template;
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
-.Ve
-.Sh "filters"
-.IX Subsection "filters"
-.Vb 3
-\&    # Set and get filters
-\&    $self    = $dbi->filters($filters);
-\&    $filters = $dbi->filters;
-.Ve
-.Sh "formats"
-.IX Subsection "formats"
-.Vb 3
-\&    # Set and get formats
-\&    $self    = $dbi->formats($formats);
-\&    $formats = $dbi->formats;
-.Ve
-.Sh "bind_filter"
-.IX Subsection "bind_filter"
-.Vb 3
-\&    # Set and get binding filter
-\&    $self        = $dbi->bind_filter($bind_filter);
-\&    $bind_filter = $dbi->bind_filter
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->bind_filter($self->filters->{default_bind_filter});
-.Ve
-.PP
-you can get \s-1DBI\s0 database handle if you need.
-.Sh "fetch_filter"
-.IX Subsection "fetch_filter"
-.Vb 3
-\&    # Set and get Fetch filter
-\&    $self         = $dbi->fetch_filter($fetch_filter);
-\&    $fetch_filter = $dbi->fetch_filter;
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->fetch_filter($self->filters->{default_fetch_filter});
-.Ve
-.Sh "no_bind_filters"
-.IX Subsection "no_bind_filters"
-.Vb 3
-\&    # Set and get no filter keys when binding
-\&    $self            = $dbi->no_bind_filters($no_bind_filters);
-\&    $no_bind_filters = $dbi->no_bind_filters;
-.Ve
-.Sh "no_fetch_filters"
-.IX Subsection "no_fetch_filters"
-.Vb 3
-\&    # Set and get no filter keys when fetching
-\&    $self             = $dbi->no_fetch_filters($no_fetch_filters);
-\&    $no_fetch_filters = $dbi->no_fetch_filters;
-.Ve
-.Sh "result_class"
-.IX Subsection "result_class"
-.Vb 3
-\&    # Set and get resultset class
-\&    $self         = $dbi->result_class($result_class);
-\&    $result_class = $dbi->result_class;
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->result_class('DBIx::Custom::Result');
-.Ve
-.Sh "dbh"
-.IX Subsection "dbh"
-.Vb 2
-\&    # Get database handle
-\&    $dbh = $self->dbh;
-.Ve
-.SH "METHODS"
-.IX Header "METHODS"
-.Sh "connect"
-.IX Subsection "connect"
-.Vb 2
-\&    # Connect to database
-\&    $self = $dbi->connect;
-.Ve
-.PP
-.Vb 4
-\&    # Sample
-\&    $dbi = DBIx::Custom->new(user => 'taro', password => 'lji8(', 
-\&                            data_soruce => "dbi:mysql:dbname=$database");
-\&    $dbi->connect;
-.Ve
-.Sh "disconnect"
-.IX Subsection "disconnect"
-.Vb 2
-\&    # Disconnect database
-\&    $dbi->disconnect;
-.Ve
-.PP
-If database is already disconnected, this method do noting.
-.Sh "reconnect"
-.IX Subsection "reconnect"
-.Vb 2
-\&    # Reconnect
-\&    $dbi->reconnect;
-.Ve
-.Sh "connected"
-.IX Subsection "connected"
-.Vb 2
-\&    # Check connected
-\&    $dbi->connected
-.Ve
-.Sh "filter_off"
-.IX Subsection "filter_off"
-.Vb 2
-\&    # bind_filter and fitch_filter off
-\&    $self->filter_off;
-.Ve
-.PP
-This is equeal to
-.PP
-.Vb 2
-\&    $self->bind_filter(undef);
-\&    $self->fetch_filter(undef);
-.Ve
-.Sh "add_filter"
-.IX Subsection "add_filter"
-.Vb 3
-\&    # Add filter (hash ref or hash can be recieve)
-\&    $self = $dbi->add_filter({$filter_name => $filter, ...});
-\&    $self = $dbi->add_filter($filetr_name => $filter, ...);
-.Ve
-.PP
-.Vb 19
-\&    # Sample
-\&    $dbi->add_filter(
-\&        decode_utf8 => sub {
-\&            my ($key, $value, $table, $column) = @_;
-\&            return Encode::decode('UTF-8', $value);
-\&        },
-\&        datetime_to_string => sub {
-\&            my ($key, $value, $table, $column) = @_;
-\&            return $value->strftime('%Y-%m-%d %H:%M:%S')
-\&        },
-\&        default_bind_filter => sub {
-\&            my ($key, $value, $table, $column) = @_;
-\&            if (ref $value eq 'Time::Piece') {
-\&                return $dbi->filters->{datetime_to_string}->($value);
-\&            }
-\&            else {
-\&                return $dbi->filters->{decode_utf8}->($value);
-\&            }
-\&        },
-.Ve
-.PP
-.Vb 18
-\&        encode_utf8 => sub {
-\&            my ($key, $value) = @_;
-\&            return Encode::encode('UTF-8', $value);
-\&        },
-\&        string_to_datetime => sub {
-\&            my ($key, $value) = @_;
-\&            return DateTime::Format::MySQL->parse_datetime($value);
-\&        },
-\&        default_fetch_filter => sub {
-\&            my ($key, $value, $type, $sth, $i) = @_;
-\&            if ($type eq 'DATETIME') {
-\&                return $dbi->filters->{string_to_datetime}->($value);
-\&            }
-\&            else {
-\&                return $dbi->filters->{encode_utf8}->($value);
-\&            }
-\&        }
-\&    );
-.Ve
-.PP
-add_filter add filter to filters
-.Sh "add_format"
-.IX Subsection "add_format"
-.Vb 1
-\&    $dbi->add_format(date => '%Y:%m:%d');
-.Ve
-.Sh "create_query"
-.IX Subsection "create_query"
-.Vb 2
-\&    # Create Query object from SQL template
-\&    my $query = $dbi->create_query($template);
-.Ve
-.Sh "execute"
-.IX Subsection "execute"
-.Vb 3
-\&    # Parse SQL template and execute SQL
-\&    $result = $dbi->query($query, $params);
-\&    $result = $dbi->query($template, $params); # Shorcut
-.Ve
-.PP
-.Vb 3
-\&    # Sample
-\&    $result = $dbi->query("select * from authors where {= name} and {= age}", 
-\&                          {author => 'taro', age => 19});
-.Ve
-.PP
-.Vb 3
-\&    while (my @row = $result->fetch) {
-\&        # do something
-\&    }
-.Ve
-.PP
-See also DBIx::Custom::SQL::Template
-.Sh "run_transaction"
-.IX Subsection "run_transaction"
-.Vb 4
-\&    # Run transaction
-\&    $dbi->run_transaction(sub {
-\&        # do something
-\&    });
-.Ve
-.PP
-If transaction is success, commit is execute. 
-If tranzation is died, rollback is execute.
-.Sh "insert"
-.IX Subsection "insert"
-.Vb 2
-\&    # Insert
-\&    $dbi->insert($table, $insert_values);
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
-.Ve
-.Sh "update"
-.IX Subsection "update"
-.Vb 2
-\&    # Update
-\&    $dbi->update($table, $update_values, $where);
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
-.Ve
-.Sh "update_all"
-.IX Subsection "update_all"
-.Vb 2
-\&    # Update all rows
-\&    $dbi->update($table, $updat_values);
-.Ve
-.Sh "delete"
-.IX Subsection "delete"
-.Vb 2
-\&    # Delete
-\&    $dbi->delete($table, $where);
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    $dbi->delete('Books', {id => 5});
-.Ve
-.Sh "delete_all"
-.IX Subsection "delete_all"
-.Vb 2
-\&    # Delete all rows
-\&    $dbi->delete_all($table);
-.Ve
-.Sh "last_insert_id"
-.IX Subsection "last_insert_id"
-.Vb 2
-\&    # Get last insert id
-\&    $last_insert_id = $dbi->last_insert_id;
-.Ve
-.PP
-This method is same as \s-1DBI\s0 last_insert_id;
-.Sh "select"
-.IX Subsection "select"
-.Vb 8
-\&    # Select
-\&    $dbi->select(
-\&        $table,                # must be string or array;
-\&        [@$columns],           # must be array reference. this is optional
-\&        {%$where_params},      # must be hash reference.  this is optional
-\&        $append_statement,     # must be string.          this is optional
-\&        $query_edit_callback   # must be code reference.  this is optional
-\&    );
-.Ve
-.PP
-.Vb 13
-\&    # Sample
-\&    $dbi->select(
-\&        'Books',
-\&        ['title', 'author'],
-\&        {id => 1},
-\&        "for update",
-\&        sub {
-\&            my $query = shift;
-\&            $query->bind_filter(sub {
-\&                # ...
-\&            });
-\&        }
-\&    );
-.Ve
-.PP
-.Vb 7
-\&    # The way to join multi tables
-\&    $dbi->select(
-\&        ['table1', 'table2'],
-\&        ['table1.id as table1_id', 'title'],
-\&        {table1.id => 1},
-\&        "where table1.id = table2.id",
-\&    );
-.Ve
-.SH "Class Accessors"
-.IX Header "Class Accessors"
-.Sh "query_cache_max"
-.IX Subsection "query_cache_max"
-.Vb 3
-\&    # Max query cache count
-\&    $class           = $class->query_cache_max($query_cache_max);
-\&    $query_cache_max = $class->query_cache_max;
-.Ve
-.PP
-.Vb 2
-\&    # Sample
-\&    DBIx::Custom->query_cache_max(50);
-.Ve
-.SH "CAUTION"
-.IX Header "CAUTION"
-DBIx::Custom have \s-1DIB\s0 object internal.
-This module is work well in the following \s-1DBI\s0 condition.
-.PP
-.Vb 2
-\&    1. AutoCommit is true
-\&    2. RaiseError is true
-.Ve
-.PP
-By default, Both AutoCommit and RaiseError is true.
-You must not change these mode not to damage your data.
-.PP
-If you change these mode, 
-you cannot get correct error message, 
-or run_transaction may fail.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Yuki Kimoto, \f(CW\*(C`<kimoto.yuki at gmail.com>\*(C'\fR
-.PP
-Github <http://github.com/yuki\-kimoto>
-.SH "COPYRIGHT & LICENSE"
-.IX Header "COPYRIGHT & LICENSE"
-Copyright 2009 Yuki Kimoto, all rights reserved.
-.PP
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.

-217

DBIx-Custom-0.0501/blib/libdoc/DBIx::Custom::Basic.3pm

View

...	...	@@ -1,217 +0,0 @@
1		-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2		-.\"
3		-.\" Standard preamble:
4		-.\" ========================================================================
5		-.de Sh \" Subsection heading
6		-.br
7		-.if t .Sp
8		-.ne 5
9		-.PP
10		-\fB\\$1\fR
11		-.PP
12		-..
13		-.de Sp \" Vertical space (when we can't use .PP)
14		-.if t .sp .5v
15		-.if n .sp
16		-..
17		-.de Vb \" Begin verbatim text
18		-.ft CW
19		-.nf
20		-.ne \\$1
21		-..
22		-.de Ve \" End verbatim text
23		-.ft R
24		-.fi
25		-..
26		-.\" Set up some character translations and predefined strings. \*(-- will
27		-.\" give an unbreakable dash, \(PI will give pi, \(L" will give a left
28		-.\" double quote, and \*(R" will give a right double quote. \| will give a
29		-.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to
30		-.\" do unbreakable dashes and therefore won't be available. \(C` and \(C'
31		-.\" expand to `' in nroff, nothing in troff, for use with C<>.
32		-.tr \(W-\|\(bv\(Tr
33		-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34		-.ie n \{\
35		-. ds -- \(*W-
36		-. ds PI pi
37		-. if (\n(.H=4u)&(1m=24u) .ds -- \(W\h'-12u'\(W\h'-12u'-\" diablo 10 pitch
38		-. if (\n(.H=4u)&(1m=20u) .ds -- \(W\h'-12u'\(W\h'-8u'-\" diablo 12 pitch
39		-. ds L" ""
40		-. ds R" ""
41		-. ds C` ""
42		-. ds C' ""
43		-'br\}
44		-.el\{\
45		-. ds -- \\|\(em\\|
46		-. ds PI \(*p
47		-. ds L" ``
48		-. ds R" ''
49		-'br\}
50		-.\"
51		-.\" If the F register is turned on, we'll generate index entries on stderr for
52		-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53		-.\" entries marked with X<> in POD. Of course, you'll have to process the
54		-.\" output yourself in some meaningful fashion.
55		-.if \nF \{\
56		-. de IX
57		-. tm Index:\\$1\t\\n%\t"\\$2"
58		-..
59		-. nr % 0
60		-. rr F
61		-.\}
62		-.\"
63		-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
64		-.\" way too many mistakes in technical documents.
65		-.hy 0
66		-.if n .na
67		-.\"
68		-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69		-.\" Fear. Run. Save yourself. No user-serviceable parts.
70		-. \" fudge factors for nroff and troff
71		-.if n \{\
72		-. ds #H 0
73		-. ds #V .8m
74		-. ds #F .3m
75		-. ds #[ \f1
76		-. ds #] \fP
77		-.\}
78		-.if t \{\
79		-. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80		-. ds #V .6m
81		-. ds #F 0
82		-. ds #[ \&
83		-. ds #] \&
84		-.\}
85		-. \" simple accents for nroff and troff
86		-.if n \{\
87		-. ds ' \&
88		-. ds ` \&
89		-. ds ^ \&
90		-. ds , \&
91		-. ds ~ ~
92		-. ds /
93		-.\}
94		-.if t \{\
95		-. ds ' \\k:\h'-(\\n(.wu8/10-\(#H)'\'\h"\|\\n:u"
96		-. ds ` \\k:\h'-(\\n(.wu8/10-\(#H)'\`\h'\|\\n:u'
97		-. ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'^\h'\|\\n:u'
98		-. ds , \\k:\h'-(\\n(.wu*8/10)',\h'\|\\n:u'
99		-. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'\|\\n:u'
100		-. ds / \\k:\h'-(\\n(.wu8/10-\(#H)'\z\(sl\h'\|\\n:u'
101		-.\}
102		-. \" troff and (daisy-wheel) nroff accents
103		-.ds : \\k:\h'-(\\n(.wu8/10-\(#H+.1m+\(#F)'\v'-\(#V'\z.\h'.2m+\(#F'.\h'\|\\n:u'\v'\(#V'
104		-.ds 8 \h'\(#H'\(b\h'-\*(#H'
105		-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\(#H)/2u'\v'-.3n'\(#[\z\(de\v'.3n'\h'\|\\n:u'\*(#]
106		-.ds d- \h'\(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\(#H'
107		-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'\|\\n:u'
108		-.ds th \(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u2/3)'\s-1o\s+1\*(#]
109		-.ds Th \(#[\s+2I\s-2\h'-\w'I'u3/5'\v'-.3m'o\v'.3m'\*(#]
110		-.ds ae a\h'-(\w'a'u*4/10)'e
111		-.ds Ae A\h'-(\w'A'u*4/10)'E
112		-. \" corrections for vroff
113		-.if v .ds ~ \\k:\h'-(\\n(.wu9/10-\(#H)'\s-2\u~\d\s+2\h'\|\\n:u'
114		-.if v .ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'\v'-.4m'^\v'.4m'\h'\|\\n:u'
115		-. \" for low resolution devices (crt and lpr)
116		-.if \n(.H>23 .if \n(.V>19 \
117		-\{\
118		-. ds : e
119		-. ds 8 ss
120		-. ds o a
121		-. ds d- d\h'-1'\(ga
122		-. ds D- D\h'-1'\(hy
123		-. ds th \o'bp'
124		-. ds Th \o'LP'
125		-. ds ae ae
126		-. ds Ae AE
127		-.\}
128		-.rm #[ #] #H #V #F C
129		-.\" ========================================================================
130		-.\"
131		-.IX Title "DBIx::Custom::Basic 3"
132		-.TH DBIx::Custom::Basic 3 "2009-11-16" "perl v5.8.8" "User Contributed Perl Documentation"
133		-.SH "NAME"
134		-DBIx::Custom::Basic \- DBIx::Custom basic implementation
135		-.SH "Version"
136		-.IX Header "Version"
137		-Version 0.0201
138		-.SH "See DBIx::Custom documentation"
139		-.IX Header "See DBIx::Custom documentation"
140		-This class is DBIx::Custom subclass.
141		-.PP
142		-You can use all methods of DBIx::Custom
143		-.PP
144		-Please see DBIx::Custom documentation
145		-.SH "Filters"
146		-.IX Header "Filters"
147		-.Sh "encode_utf8"
148		-.IX Subsection "encode_utf8"
149		-.Vb 2
150		-\& # Encode to UTF-8 byte stream (utf8::upgrade is done if need)
151		-\& $dbi->filters->{encode_utf8}->($value);
152		-.Ve
153		-.PP
154		-This filter is generally used as bind filter
155		-.PP
156		-.Vb 1
157		-\& $dbi->bind_filter($dbi->filters->{encode_utf8});
158		-.Ve
159		-.Sh "decode_utf8"
160		-.IX Subsection "decode_utf8"
161		-.Vb 2
162		-\& # Decode to perl internal string
163		-\& $dbi->filters->{decode_utf8}->($value);
164		-.Ve
165		-.PP
166		-This filter is generally used as fetch filter
167		-.PP
168		-.Vb 1
169		-\& $dbi->fetch_filter($dbi->filters->{decode_utf8});
170		-.Ve
171		-.Sh "Formats"
172		-.IX Subsection "Formats"
173		-strptime formats is available
174		-.PP
175		-.Vb 7
176		-\& # format name format
177		-\& 'SQL99_date' '%Y-%m-%d',
178		-\& 'SQL99_datetime' '%Y-%m-%d %H:%M:%S',
179		-\& 'SQL99_time' '%H:%M:%S',
180		-\& 'ISO-8601_date' '%Y-%m-%d',
181		-\& 'ISO-8601_datetime' '%Y-%m-%dT%H:%M:%S',
182		-\& 'ISO-8601_time' '%H:%M:%S',
183		-.Ve
184		-.PP
185		-You get format as the following
186		-.PP
187		-.Vb 1
188		-\& my $format = $dbi->formats->{$format_name};
189		-.Ve
190		-.SH "Methods"
191		-.IX Header "Methods"
192		-.Sh "utf8_filter_on"
193		-.IX Subsection "utf8_filter_on"
194		-.Vb 2
195		-\& # Encode and decode utf8 filter on
196		-\& $dbi->utf8_filter_on;
197		-.Ve
198		-.PP
199		-This equel to
200		-.PP
201		-.Vb 2
202		-\& $dbi->bind_filter($dbi->filters->{encode_utf8});
203		-\& $dbi->fetch_filter($dbi->filters->{decode_utf8});
204		-.Ve
205		-.SH "AUTHOR"
206		-.IX Header "AUTHOR"
207		-Yuki Kimoto, \f(CW\(C`<kimoto.yuki at gmail.com>\(C'\fR
208		-.PP
209		-Github <http://github.com/yuki\-kimoto>
210		-.PP
211		-I develope this module <http://github.com/yuki\-kimoto/DBIx\-Custom>
212		-.SH "COPYRIGHT & LICENSE"
213		-.IX Header "COPYRIGHT & LICENSE"
214		-Copyright 2009 Yuki Kimoto, all rights reserved.
215		-.PP
216		-This program is free software; you can redistribute it and/or modify it
217		-under the same terms as Perl itself.

-198

DBIx-Custom-0.0501/blib/libdoc/DBIx::Custom::MySQL.3pm

View

...	...	@@ -1,198 +0,0 @@
1		-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2		-.\"
3		-.\" Standard preamble:
4		-.\" ========================================================================
5		-.de Sh \" Subsection heading
6		-.br
7		-.if t .Sp
8		-.ne 5
9		-.PP
10		-\fB\\$1\fR
11		-.PP
12		-..
13		-.de Sp \" Vertical space (when we can't use .PP)
14		-.if t .sp .5v
15		-.if n .sp
16		-..
17		-.de Vb \" Begin verbatim text
18		-.ft CW
19		-.nf
20		-.ne \\$1
21		-..
22		-.de Ve \" End verbatim text
23		-.ft R
24		-.fi
25		-..
26		-.\" Set up some character translations and predefined strings. \*(-- will
27		-.\" give an unbreakable dash, \(PI will give pi, \(L" will give a left
28		-.\" double quote, and \*(R" will give a right double quote. \| will give a
29		-.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to
30		-.\" do unbreakable dashes and therefore won't be available. \(C` and \(C'
31		-.\" expand to `' in nroff, nothing in troff, for use with C<>.
32		-.tr \(W-\|\(bv\(Tr
33		-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34		-.ie n \{\
35		-. ds -- \(*W-
36		-. ds PI pi
37		-. if (\n(.H=4u)&(1m=24u) .ds -- \(W\h'-12u'\(W\h'-12u'-\" diablo 10 pitch
38		-. if (\n(.H=4u)&(1m=20u) .ds -- \(W\h'-12u'\(W\h'-8u'-\" diablo 12 pitch
39		-. ds L" ""
40		-. ds R" ""
41		-. ds C` ""
42		-. ds C' ""
43		-'br\}
44		-.el\{\
45		-. ds -- \\|\(em\\|
46		-. ds PI \(*p
47		-. ds L" ``
48		-. ds R" ''
49		-'br\}
50		-.\"
51		-.\" If the F register is turned on, we'll generate index entries on stderr for
52		-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53		-.\" entries marked with X<> in POD. Of course, you'll have to process the
54		-.\" output yourself in some meaningful fashion.
55		-.if \nF \{\
56		-. de IX
57		-. tm Index:\\$1\t\\n%\t"\\$2"
58		-..
59		-. nr % 0
60		-. rr F
61		-.\}
62		-.\"
63		-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
64		-.\" way too many mistakes in technical documents.
65		-.hy 0
66		-.if n .na
67		-.\"
68		-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69		-.\" Fear. Run. Save yourself. No user-serviceable parts.
70		-. \" fudge factors for nroff and troff
71		-.if n \{\
72		-. ds #H 0
73		-. ds #V .8m
74		-. ds #F .3m
75		-. ds #[ \f1
76		-. ds #] \fP
77		-.\}
78		-.if t \{\
79		-. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80		-. ds #V .6m
81		-. ds #F 0
82		-. ds #[ \&
83		-. ds #] \&
84		-.\}
85		-. \" simple accents for nroff and troff
86		-.if n \{\
87		-. ds ' \&
88		-. ds ` \&
89		-. ds ^ \&
90		-. ds , \&
91		-. ds ~ ~
92		-. ds /
93		-.\}
94		-.if t \{\
95		-. ds ' \\k:\h'-(\\n(.wu8/10-\(#H)'\'\h"\|\\n:u"
96		-. ds ` \\k:\h'-(\\n(.wu8/10-\(#H)'\`\h'\|\\n:u'
97		-. ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'^\h'\|\\n:u'
98		-. ds , \\k:\h'-(\\n(.wu*8/10)',\h'\|\\n:u'
99		-. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'\|\\n:u'
100		-. ds / \\k:\h'-(\\n(.wu8/10-\(#H)'\z\(sl\h'\|\\n:u'
101		-.\}
102		-. \" troff and (daisy-wheel) nroff accents
103		-.ds : \\k:\h'-(\\n(.wu8/10-\(#H+.1m+\(#F)'\v'-\(#V'\z.\h'.2m+\(#F'.\h'\|\\n:u'\v'\(#V'
104		-.ds 8 \h'\(#H'\(b\h'-\*(#H'
105		-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\(#H)/2u'\v'-.3n'\(#[\z\(de\v'.3n'\h'\|\\n:u'\*(#]
106		-.ds d- \h'\(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\(#H'
107		-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'\|\\n:u'
108		-.ds th \(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u2/3)'\s-1o\s+1\*(#]
109		-.ds Th \(#[\s+2I\s-2\h'-\w'I'u3/5'\v'-.3m'o\v'.3m'\*(#]
110		-.ds ae a\h'-(\w'a'u*4/10)'e
111		-.ds Ae A\h'-(\w'A'u*4/10)'E
112		-. \" corrections for vroff
113		-.if v .ds ~ \\k:\h'-(\\n(.wu9/10-\(#H)'\s-2\u~\d\s+2\h'\|\\n:u'
114		-.if v .ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'\v'-.4m'^\v'.4m'\h'\|\\n:u'
115		-. \" for low resolution devices (crt and lpr)
116		-.if \n(.H>23 .if \n(.V>19 \
117		-\{\
118		-. ds : e
119		-. ds 8 ss
120		-. ds o a
121		-. ds d- d\h'-1'\(ga
122		-. ds D- D\h'-1'\(hy
123		-. ds th \o'bp'
124		-. ds Th \o'LP'
125		-. ds ae ae
126		-. ds Ae AE
127		-.\}
128		-.rm #[ #] #H #V #F C
129		-.\" ========================================================================
130		-.\"
131		-.IX Title "DBIx::Custom::MySQL 3"
132		-.TH DBIx::Custom::MySQL 3 "2009-11-16" "perl v5.8.8" "User Contributed Perl Documentation"
133		-.SH "NAME"
134		-DBIx::Custom::MySQL \- DBIx::Custom MySQL implementation
135		-.SH "Version"
136		-.IX Header "Version"
137		-Version 0.0102
138		-.SH "Synopsys"
139		-.IX Header "Synopsys"
140		-.Vb 5
141		-\& # New
142		-\& my $dbi = DBIx::Custom::MySQL->new(user => 'taro', $password => 'kliej&@K',
143		-\& database => 'sample_db');
144		-\& # Insert
145		-\& $dbi->insert('books', {title => 'perl', author => 'taro'});
146		-.Ve
147		-.PP
148		-.Vb 3
149		-\& # Update
150		-\& # same as 'update books set (title = 'aaa', author = 'ken') where id = 5;
151		-\& $dbi->update('books', {title => 'aaa', author => 'ken'}, {id => 5});
152		-.Ve
153		-.PP
154		-.Vb 2
155		-\& # Delete
156		-\& $dbi->delete('books', {author => 'taro'});
157		-.Ve
158		-.PP
159		-.Vb 2
160		-\& # select * from books;
161		-\& $dbi->select('books');
162		-.Ve
163		-.PP
164		-.Vb 2
165		-\& # select * from books where ahthor = 'taro';
166		-\& $dbi->select('books', {author => 'taro'});
167		-.Ve
168		-.SH "See DBIx::Custom and DBI::Custom::Basic documentation"
169		-.IX Header "See DBIx::Custom and DBI::Custom::Basic documentation"
170		-This class is DBIx::Custom::Basic subclass,
171		-and DBIx::Custom::Basic is DBIx::Custom subclass.
172		-.PP
173		-You can use all methods of DBIx::Custom::Basic and <DBIx::Custom>
174		-Please see DBIx::Custom::Basic and <DBIx::Custom> documentation.
175		-.SH "Object methods"
176		-.IX Header "Object methods"
177		-.Sh "connect"
178		-.IX Subsection "connect"
179		-.Vb 1
180		-\& This method override DBIx::Custom::connect
181		-.Ve
182		-.PP
183		-.Vb 1
184		-\& If database attribute is set, automatically data source is created and connect
185		-.Ve
186		-.SH "Author"
187		-.IX Header "Author"
188		-Yuki Kimoto, \f(CW\(C`<kimoto.yuki at gmail.com>\(C'\fR
189		-.PP
190		-Github <http://github.com/yuki\-kimoto>
191		-.PP
192		-I develope this module <http://github.com/yuki\-kimoto/DBIx\-Custom>
193		-.SH "Copyright & license"
194		-.IX Header "Copyright & license"
195		-Copyright 2009 Yuki Kimoto, all rights reserved.
196		-.PP
197		-This program is free software; you can redistribute it and/or modify it
198		-under the same terms as Perl itself.

-222

DBIx-Custom-0.0501/blib/libdoc/DBIx::Custom::Query.3pm

View

...	...	@@ -1,222 +0,0 @@
1		-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2		-.\"
3		-.\" Standard preamble:
4		-.\" ========================================================================
5		-.de Sh \" Subsection heading
6		-.br
7		-.if t .Sp
8		-.ne 5
9		-.PP
10		-\fB\\$1\fR
11		-.PP
12		-..
13		-.de Sp \" Vertical space (when we can't use .PP)
14		-.if t .sp .5v
15		-.if n .sp
16		-..
17		-.de Vb \" Begin verbatim text
18		-.ft CW
19		-.nf
20		-.ne \\$1
21		-..
22		-.de Ve \" End verbatim text
23		-.ft R
24		-.fi
25		-..
26		-.\" Set up some character translations and predefined strings. \*(-- will
27		-.\" give an unbreakable dash, \(PI will give pi, \(L" will give a left
28		-.\" double quote, and \*(R" will give a right double quote. \| will give a
29		-.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to
30		-.\" do unbreakable dashes and therefore won't be available. \(C` and \(C'
31		-.\" expand to `' in nroff, nothing in troff, for use with C<>.
32		-.tr \(W-\|\(bv\(Tr
33		-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34		-.ie n \{\
35		-. ds -- \(*W-
36		-. ds PI pi
37		-. if (\n(.H=4u)&(1m=24u) .ds -- \(W\h'-12u'\(W\h'-12u'-\" diablo 10 pitch
38		-. if (\n(.H=4u)&(1m=20u) .ds -- \(W\h'-12u'\(W\h'-8u'-\" diablo 12 pitch
39		-. ds L" ""
40		-. ds R" ""
41		-. ds C` ""
42		-. ds C' ""
43		-'br\}
44		-.el\{\
45		-. ds -- \\|\(em\\|
46		-. ds PI \(*p
47		-. ds L" ``
48		-. ds R" ''
49		-'br\}
50		-.\"
51		-.\" If the F register is turned on, we'll generate index entries on stderr for
52		-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53		-.\" entries marked with X<> in POD. Of course, you'll have to process the
54		-.\" output yourself in some meaningful fashion.
55		-.if \nF \{\
56		-. de IX
57		-. tm Index:\\$1\t\\n%\t"\\$2"
58		-..
59		-. nr % 0
60		-. rr F
61		-.\}
62		-.\"
63		-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
64		-.\" way too many mistakes in technical documents.
65		-.hy 0
66		-.if n .na
67		-.\"
68		-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69		-.\" Fear. Run. Save yourself. No user-serviceable parts.
70		-. \" fudge factors for nroff and troff
71		-.if n \{\
72		-. ds #H 0
73		-. ds #V .8m
74		-. ds #F .3m
75		-. ds #[ \f1
76		-. ds #] \fP
77		-.\}
78		-.if t \{\
79		-. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80		-. ds #V .6m
81		-. ds #F 0
82		-. ds #[ \&
83		-. ds #] \&
84		-.\}
85		-. \" simple accents for nroff and troff
86		-.if n \{\
87		-. ds ' \&
88		-. ds ` \&
89		-. ds ^ \&
90		-. ds , \&
91		-. ds ~ ~
92		-. ds /
93		-.\}
94		-.if t \{\
95		-. ds ' \\k:\h'-(\\n(.wu8/10-\(#H)'\'\h"\|\\n:u"
96		-. ds ` \\k:\h'-(\\n(.wu8/10-\(#H)'\`\h'\|\\n:u'
97		-. ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'^\h'\|\\n:u'
98		-. ds , \\k:\h'-(\\n(.wu*8/10)',\h'\|\\n:u'
99		-. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'\|\\n:u'
100		-. ds / \\k:\h'-(\\n(.wu8/10-\(#H)'\z\(sl\h'\|\\n:u'
101		-.\}
102		-. \" troff and (daisy-wheel) nroff accents
103		-.ds : \\k:\h'-(\\n(.wu8/10-\(#H+.1m+\(#F)'\v'-\(#V'\z.\h'.2m+\(#F'.\h'\|\\n:u'\v'\(#V'
104		-.ds 8 \h'\(#H'\(b\h'-\*(#H'
105		-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\(#H)/2u'\v'-.3n'\(#[\z\(de\v'.3n'\h'\|\\n:u'\*(#]
106		-.ds d- \h'\(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\(#H'
107		-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'\|\\n:u'
108		-.ds th \(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u2/3)'\s-1o\s+1\*(#]
109		-.ds Th \(#[\s+2I\s-2\h'-\w'I'u3/5'\v'-.3m'o\v'.3m'\*(#]
110		-.ds ae a\h'-(\w'a'u*4/10)'e
111		-.ds Ae A\h'-(\w'A'u*4/10)'E
112		-. \" corrections for vroff
113		-.if v .ds ~ \\k:\h'-(\\n(.wu9/10-\(#H)'\s-2\u~\d\s+2\h'\|\\n:u'
114		-.if v .ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'\v'-.4m'^\v'.4m'\h'\|\\n:u'
115		-. \" for low resolution devices (crt and lpr)
116		-.if \n(.H>23 .if \n(.V>19 \
117		-\{\
118		-. ds : e
119		-. ds 8 ss
120		-. ds o a
121		-. ds d- d\h'-1'\(ga
122		-. ds D- D\h'-1'\(hy
123		-. ds th \o'bp'
124		-. ds Th \o'LP'
125		-. ds ae ae
126		-. ds Ae AE
127		-.\}
128		-.rm #[ #] #H #V #F C
129		-.\" ========================================================================
130		-.\"
131		-.IX Title "DBIx::Custom::Query 3"
132		-.TH DBIx::Custom::Query 3 "2009-11-16" "perl v5.8.8" "User Contributed Perl Documentation"
133		-.SH "NAME"
134		-DBIx::Custom::Query \- Query object for DBIx::Custom
135		-.SH "VERSION"
136		-.IX Header "VERSION"
137		-Version 0.0101
138		-.SH "SYNOPSIS"
139		-.IX Header "SYNOPSIS"
140		-.Vb 3
141		-\& # Create query
142		-\& my $dbi = DBIx::Custom->new;
143		-\& my $query = $dbi->create_query($template);
144		-.Ve
145		-.PP
146		-.Vb 3
147		-\& # Set query attributes
148		-\& $query->bind_filter($dbi->filters->{default_bind_filter});
149		-\& $query->no_bind_filters('title', 'author');
150		-.Ve
151		-.PP
152		-.Vb 2
153		-\& $query->fetch_filter($dbi->filters->{default_fetch_filter});
154		-\& $query->no_fetch_filters('title', 'author');
155		-.Ve
156		-.PP
157		-.Vb 2
158		-\& # Execute query
159		-\& $dbi->execute($query, $params);
160		-.Ve
161		-.SH "OBJECT ACCESSORS"
162		-.IX Header "OBJECT ACCESSORS"
163		-.Sh "sth"
164		-.IX Subsection "sth"
165		-.Vb 3
166		-\& # Set and get statement handle
167		-\& $self = $query->sth($sql);
168		-\& $sth = $query->sth;
169		-.Ve
170		-.Sh "sql"
171		-.IX Subsection "sql"
172		-.Vb 3
173		-\& # Set and get SQL
174		-\& $self = $query->sql($sql);
175		-\& $sql = $query->sql;
176		-.Ve
177		-.Sh "bind_filter"
178		-.IX Subsection "bind_filter"
179		-.Vb 3
180		-\& # Set and get bind filter
181		-\& $self = $query->bind_filter($bind_filter);
182		-\& $bind_filter = $query->bind_filter;
183		-.Ve
184		-.Sh "no_bind_filters"
185		-.IX Subsection "no_bind_filters"
186		-.Vb 3
187		-\& # Set and get keys of no filtering
188		-\& $self = $query->no_bind_filters($no_filters);
189		-\& $no_bind_filters = $query->no_bind_filters;
190		-.Ve
191		-.Sh "fetch_filter"
192		-.IX Subsection "fetch_filter"
193		-.Vb 3
194		-\& # Set and get fetch filter
195		-\& $self = $query->fetch_filter($fetch_filter);
196		-\& $fetch_filter = $query->fetch_filter;
197		-.Ve
198		-.Sh "no_fetch_filters"
199		-.IX Subsection "no_fetch_filters"
200		-.Vb 3
201		-\& # Set and get keys of no filtering
202		-\& $self = $query->no_fetch_filters($no_filters);
203		-\& $no_fetch_filters = $query->no_fetch_filters;
204		-.Ve
205		-.Sh "key_infos"
206		-.IX Subsection "key_infos"
207		-.Vb 3
208		-\& # Set and get key informations
209		-\& $self = $query->key_infos($key_infos);
210		-\& $key_infos = $query->key_infos;
211		-.Ve
212		-.SH "AUTHOR"
213		-.IX Header "AUTHOR"
214		-Yuki Kimoto, \f(CW\(C`<kimoto.yuki at gmail.com>\(C'\fR
215		-.PP
216		-Github <http://github.com/yuki\-kimoto>
217		-.SH "COPYRIGHT & LICENSE"
218		-.IX Header "COPYRIGHT & LICENSE"
219		-Copyright 2009 Yuki Kimoto, all rights reserved.
220		-.PP
221		-This program is free software; you can redistribute it and/or modify it
222		-under the same terms as Perl itself.

-367

DBIx-Custom-0.0501/blib/libdoc/DBIx::Custom::Result.3pm

View

@@ -1,367 +0,0 @@
-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sh \" Subsection heading
-.br
-.if t .Sp
-.ne 5
-.PP
-\fB\\$1\fR
-.PP
-..
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings.  \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote.  | will give a
-.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
-.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
-.\" expand to `' in nroff, nothing in troff, for use with C<>.
-.tr \(*W-|\(bv\*(Tr
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-.    ds -- \(*W-
-.    ds PI pi
-.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
-.    ds L" ""
-.    ds R" ""
-.    ds C` ""
-.    ds C' ""
-'br\}
-.el\{\
-.    ds -- \|\(em\|
-.    ds PI \(*p
-.    ds L" ``
-.    ds R" ''
-'br\}
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
-.\" entries marked with X<> in POD.  Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.if \nF \{\
-.    de IX
-.    tm Index:\\$1\t\\n%\t"\\$2"
-..
-.    nr % 0
-.    rr F
-.\}
-.\"
-.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.hy 0
-.if n .na
-.\"
-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
-.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
-.    \" fudge factors for nroff and troff
-.if n \{\
-.    ds #H 0
-.    ds #V .8m
-.    ds #F .3m
-.    ds #[ \f1
-.    ds #] \fP
-.\}
-.if t \{\
-.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
-.    ds #V .6m
-.    ds #F 0
-.    ds #[ \&
-.    ds #] \&
-.\}
-.    \" simple accents for nroff and troff
-.if n \{\
-.    ds ' \&
-.    ds ` \&
-.    ds ^ \&
-.    ds , \&
-.    ds ~ ~
-.    ds /
-.\}
-.if t \{\
-.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
-.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
-.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
-.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
-.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
-.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
-.\}
-.    \" troff and (daisy-wheel) nroff accents
-.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
-.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
-.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
-.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
-.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
-.ds ae a\h'-(\w'a'u*4/10)'e
-.ds Ae A\h'-(\w'A'u*4/10)'E
-.    \" corrections for vroff
-.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
-.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
-.    \" for low resolution devices (crt and lpr)
-.if \n(.H>23 .if \n(.V>19 \
-\{\
-.    ds : e
-.    ds 8 ss
-.    ds o a
-.    ds d- d\h'-1'\(ga
-.    ds D- D\h'-1'\(hy
-.    ds th \o'bp'
-.    ds Th \o'LP'
-.    ds ae ae
-.    ds Ae AE
-.\}
-.rm #[ #] #H #V #F C
-.\" ========================================================================
-.\"
-.IX Title "DBIx::Custom::Result 3"
-.TH DBIx::Custom::Result 3 "2009-11-16" "perl v5.8.8" "User Contributed Perl Documentation"
-.SH "NAME"
-DBIx::Custom::Result \- Resultset for DBIx::Custom
-.SH "VERSION"
-.IX Header "VERSION"
-Version 0.0301
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 3
-\&    # $result is DBIx::Custom::Result object
-\&    my $dbi = DBIx::Custom->new;
-\&    my $result = $dbi->query($sql_template, $param);
-.Ve
-.PP
-.Vb 3
-\&    while (my ($val1, $val2) = $result->fetch) {
-\&        # do something
-\&    }
-.Ve
-.SH "OBJECT ACCESSORS"
-.IX Header "OBJECT ACCESSORS"
-.Sh "sth"
-.IX Subsection "sth"
-.Vb 3
-\&    # Set and Get statement handle
-\&    $self = $result->sth($sth);
-\&    $sth  = $reuslt->sth
-.Ve
-.PP
-Statement handle is automatically set by DBIx::Custom.
-so you do not set statement handle.
-.PP
-If you need statement handle, you can get statement handle by using this method.
-.Sh "fetch_filter"
-.IX Subsection "fetch_filter"
-.Vb 3
-\&    # Set and Get fetch filter
-\&    $self         = $result->fetch_filter($sth);
-\&    $fetch_filter = $result->fech_filter;
-.Ve
-.PP
-Statement handle is automatically set by DBIx::Custom.
-If you want to set your fetch filter, you set it.
-.Sh "no_fetch_filters"
-.IX Subsection "no_fetch_filters"
-.Vb 3
-\&    # Set and Get no filter keys when fetching
-\&    $self             = $result->no_fetch_filters($no_fetch_filters);
-\&    $no_fetch_filters = $result->no_fetch_filters;
-.Ve
-.SH "METHODS"
-.IX Header "METHODS"
-.Sh "fetch"
-.IX Subsection "fetch"
-.Vb 2
-\&    # Fetch row as array reference (Scalar context)
-\&    $row = $result->fetch;
-.Ve
-.PP
-.Vb 2
-\&    # Fetch row as array (List context)
-\&    @row = $result->fecth
-.Ve
-.PP
-.Vb 6
-\&    # Sample
-\&    while (my $row = $result->fetch) {
-\&        # do something
-\&        my $val1 = $row->[0];
-\&        my $val2 = $row->[1];
-\&    }
-.Ve
-.PP
-fetch method is fetch resultset and get row as array or array reference.
-.Sh "fetch_hash"
-.IX Subsection "fetch_hash"
-.Vb 2
-\&    # Fetch row as hash reference (Scalar context)
-\&    $row = $result->fetch_hash;
-.Ve
-.PP
-.Vb 2
-\&    # Fetch row as hash (List context)
-\&    %row = $result->fecth_hash
-.Ve
-.PP
-.Vb 6
-\&    # Sample
-\&    while (my $row = $result->fetch_hash) {
-\&        # do something
-\&        my $val1 = $row->{key1};
-\&        my $val2 = $row->{key2};
-\&    }
-.Ve
-.PP
-fetch_hash method is fetch resultset and get row as hash or hash reference.
-.Sh "fetch_first"
-.IX Subsection "fetch_first"
-.Vb 2
-\&    # Fetch only first (Scalar context)
-\&    $row = $result->fetch_first;
-.Ve
-.PP
-.Vb 2
-\&    # Fetch only first (List context)
-\&    @row = $result->fetch_first;
-.Ve
-.PP
-This method fetch only first and finish statement handle
-.Sh "fetch_hash_first"
-.IX Subsection "fetch_hash_first"
-.Vb 2
-\&    # Fetch only first as hash (Scalar context)
-\&    $row = $result->fetch_hash_first;
-.Ve
-.PP
-.Vb 2
-\&    # Fetch only first as hash (Scalar context)
-\&    @row = $result->fetch_hash_first;
-.Ve
-.PP
-This method fetch only first and finish statement handle
-.Sh "fetch_rows"
-.IX Subsection "fetch_rows"
-.Vb 2
-\&    # Fetch multi rows (Scalar context)
-\&    $rows = $result->fetch_rows($row_count);
-.Ve
-.PP
-.Vb 2
-\&    # Fetch multi rows (List context)
-\&    @rows = $result->fetch_rows($row_count);
-.Ve
-.PP
-.Vb 2
-\&    # Sapmle 
-\&    $rows = $result->fetch_rows(10);
-.Ve
-.Sh "fetch_hash_rows"
-.IX Subsection "fetch_hash_rows"
-.Vb 2
-\&    # Fetch multi rows as hash (Scalar context)
-\&    $rows = $result->fetch_hash_rows($row_count);
-.Ve
-.PP
-.Vb 2
-\&    # Fetch multi rows as hash (List context)
-\&    @rows = $result->fetch_hash_rows($row_count);
-.Ve
-.PP
-.Vb 2
-\&    # Sapmle 
-\&    $rows = $result->fetch_hash_rows(10);
-.Ve
-.Sh "fetch_all"
-.IX Subsection "fetch_all"
-.Vb 2
-\&    # Fetch all row as array ref of array ref (Scalar context)
-\&    $rows = $result->fetch_all;
-.Ve
-.PP
-.Vb 2
-\&    # Fetch all row as array of array ref (List context)
-\&    @rows = $result->fecth_all;
-.Ve
-.PP
-.Vb 4
-\&    # Sample
-\&    my $rows = $result->fetch_all;
-\&    my $val0_0 = $rows->[0][0];
-\&    my $val1_1 = $rows->[1][1];
-.Ve
-.PP
-fetch_all method is fetch resultset and get all rows as array or array reference.
-.Sh "fetch_hash_all"
-.IX Subsection "fetch_hash_all"
-.Vb 2
-\&    # Fetch all row as array ref of hash ref (Scalar context)
-\&    $rows = $result->fetch_hash_all;
-.Ve
-.PP
-.Vb 2
-\&    # Fetch all row as array of hash ref (List context)
-\&    @rows = $result->fecth_all_hash;
-.Ve
-.PP
-.Vb 4
-\&    # Sample
-\&    my $rows = $result->fetch_hash_all;
-\&    my $val0_key1 = $rows->[0]{key1};
-\&    my $val1_key2 = $rows->[1]{key2};
-.Ve
-.Sh "error"
-.IX Subsection "error"
-.Vb 3
-\&    # Get error infomation
-\&    $error_messege = $result->error;
-\&    ($error_message, $error_number, $error_state) = $result->error;
-.Ve
-.PP
-You can get get information. This is crenspond to the following.
-.PP
-.Vb 3
-\&    $error_message : $result->sth->errstr
-\&    $error_number  : $result->sth->err
-\&    $error_state   : $result->sth->state
-.Ve
-.Sh "finish"
-.IX Subsection "finish"
-.Vb 2
-\&    # Finish statement handle
-\&    $result->finish
-.Ve
-.PP
-.Vb 3
-\&    # Sample
-\&    my $row = $reuslt->fetch; # fetch only one row
-\&    $result->finish
-.Ve
-.PP
-You can finish statement handle.This is equel to
-.PP
-.Vb 1
-\&    $result->sth->finish;
-.Ve
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Yuki Kimoto, \f(CW\*(C`<kimoto.yuki at gmail.com>\*(C'\fR
-.PP
-Github <http://github.com/yuki\-kimoto>
-.SH "COPYRIGHT & LICENSE"
-.IX Header "COPYRIGHT & LICENSE"
-Copyright 2009 Yuki Kimoto, all rights reserved.
-.PP
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.

-404

DBIx-Custom-0.0501/blib/libdoc/DBIx::Custom::SQL::Template.3pm

View

...	...	@@ -1,404 +0,0 @@
1		-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2		-.\"
3		-.\" Standard preamble:
4		-.\" ========================================================================
5		-.de Sh \" Subsection heading
6		-.br
7		-.if t .Sp
8		-.ne 5
9		-.PP
10		-\fB\\$1\fR
11		-.PP
12		-..
13		-.de Sp \" Vertical space (when we can't use .PP)
14		-.if t .sp .5v
15		-.if n .sp
16		-..
17		-.de Vb \" Begin verbatim text
18		-.ft CW
19		-.nf
20		-.ne \\$1
21		-..
22		-.de Ve \" End verbatim text
23		-.ft R
24		-.fi
25		-..
26		-.\" Set up some character translations and predefined strings. \*(-- will
27		-.\" give an unbreakable dash, \(PI will give pi, \(L" will give a left
28		-.\" double quote, and \*(R" will give a right double quote. \| will give a
29		-.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to
30		-.\" do unbreakable dashes and therefore won't be available. \(C` and \(C'
31		-.\" expand to `' in nroff, nothing in troff, for use with C<>.
32		-.tr \(W-\|\(bv\(Tr
33		-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34		-.ie n \{\
35		-. ds -- \(*W-
36		-. ds PI pi
37		-. if (\n(.H=4u)&(1m=24u) .ds -- \(W\h'-12u'\(W\h'-12u'-\" diablo 10 pitch
38		-. if (\n(.H=4u)&(1m=20u) .ds -- \(W\h'-12u'\(W\h'-8u'-\" diablo 12 pitch
39		-. ds L" ""
40		-. ds R" ""
41		-. ds C` ""
42		-. ds C' ""
43		-'br\}
44		-.el\{\
45		-. ds -- \\|\(em\\|
46		-. ds PI \(*p
47		-. ds L" ``
48		-. ds R" ''
49		-'br\}
50		-.\"
51		-.\" If the F register is turned on, we'll generate index entries on stderr for
52		-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53		-.\" entries marked with X<> in POD. Of course, you'll have to process the
54		-.\" output yourself in some meaningful fashion.
55		-.if \nF \{\
56		-. de IX
57		-. tm Index:\\$1\t\\n%\t"\\$2"
58		-..
59		-. nr % 0
60		-. rr F
61		-.\}
62		-.\"
63		-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
64		-.\" way too many mistakes in technical documents.
65		-.hy 0
66		-.if n .na
67		-.\"
68		-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69		-.\" Fear. Run. Save yourself. No user-serviceable parts.
70		-. \" fudge factors for nroff and troff
71		-.if n \{\
72		-. ds #H 0
73		-. ds #V .8m
74		-. ds #F .3m
75		-. ds #[ \f1
76		-. ds #] \fP
77		-.\}
78		-.if t \{\
79		-. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80		-. ds #V .6m
81		-. ds #F 0
82		-. ds #[ \&
83		-. ds #] \&
84		-.\}
85		-. \" simple accents for nroff and troff
86		-.if n \{\
87		-. ds ' \&
88		-. ds ` \&
89		-. ds ^ \&
90		-. ds , \&
91		-. ds ~ ~
92		-. ds /
93		-.\}
94		-.if t \{\
95		-. ds ' \\k:\h'-(\\n(.wu8/10-\(#H)'\'\h"\|\\n:u"
96		-. ds ` \\k:\h'-(\\n(.wu8/10-\(#H)'\`\h'\|\\n:u'
97		-. ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'^\h'\|\\n:u'
98		-. ds , \\k:\h'-(\\n(.wu*8/10)',\h'\|\\n:u'
99		-. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'\|\\n:u'
100		-. ds / \\k:\h'-(\\n(.wu8/10-\(#H)'\z\(sl\h'\|\\n:u'
101		-.\}
102		-. \" troff and (daisy-wheel) nroff accents
103		-.ds : \\k:\h'-(\\n(.wu8/10-\(#H+.1m+\(#F)'\v'-\(#V'\z.\h'.2m+\(#F'.\h'\|\\n:u'\v'\(#V'
104		-.ds 8 \h'\(#H'\(b\h'-\*(#H'
105		-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\(#H)/2u'\v'-.3n'\(#[\z\(de\v'.3n'\h'\|\\n:u'\*(#]
106		-.ds d- \h'\(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\(#H'
107		-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'\|\\n:u'
108		-.ds th \(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u2/3)'\s-1o\s+1\*(#]
109		-.ds Th \(#[\s+2I\s-2\h'-\w'I'u3/5'\v'-.3m'o\v'.3m'\*(#]
110		-.ds ae a\h'-(\w'a'u*4/10)'e
111		-.ds Ae A\h'-(\w'A'u*4/10)'E
112		-. \" corrections for vroff
113		-.if v .ds ~ \\k:\h'-(\\n(.wu9/10-\(#H)'\s-2\u~\d\s+2\h'\|\\n:u'
114		-.if v .ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'\v'-.4m'^\v'.4m'\h'\|\\n:u'
115		-. \" for low resolution devices (crt and lpr)
116		-.if \n(.H>23 .if \n(.V>19 \
117		-\{\
118		-. ds : e
119		-. ds 8 ss
120		-. ds o a
121		-. ds d- d\h'-1'\(ga
122		-. ds D- D\h'-1'\(hy
123		-. ds th \o'bp'
124		-. ds Th \o'LP'
125		-. ds ae ae
126		-. ds Ae AE
127		-.\}
128		-.rm #[ #] #H #V #F C
129		-.\" ========================================================================
130		-.\"
131		-.IX Title "DBIx::Custom::SQL::Template 3"
132		-.TH DBIx::Custom::SQL::Template 3 "2009-11-16" "perl v5.8.8" "User Contributed Perl Documentation"
133		-.SH "NAME"
134		-DBIx::Custom::SQL::Template \- Custamizable SQL Template for DBIx::Custom
135		-.SH "VERSION"
136		-.IX Header "VERSION"
137		-Version 0.0101
138		-.SH "SYNOPSIS"
139		-.IX Header "SYNOPSIS"
140		-.Vb 1
141		-\& my $sql_tmpl = DBIx::Custom::SQL::Template->new;
142		-.Ve
143		-.PP
144		-.Vb 2
145		-\& my $tmpl = "select from table {= k1} && {<> k2} \|\| {like k3}";
146		-\& my $param = {k1 => 1, k2 => 2, k3 => 3};
147		-.Ve
148		-.PP
149		-.Vb 1
150		-\& my $query = $sql_template->create_query($tmpl);
151		-.Ve
152		-.PP
153		-.Vb 8
154		-\& # Using query from DBIx::Custom
155		-\& use DBIx::Custom;
156		-\& my $dbi = DBI->new(
157		-\& data_source => $data_source,
158		-\& user => $user,
159		-\& password => $password,
160		-\& dbi_options => {PrintError => 0, RaiseError => 1}
161		-\& );
162		-.Ve
163		-.PP
164		-.Vb 2
165		-\& $query = $dbi->create_query($tmpl); # This is SQL::Template create_query
166		-\& $dbi->query($query, $param);
167		-.Ve
168		-.SH "CLASS-OBJECT ACCESSORS"
169		-.IX Header "CLASS-OBJECT ACCESSORS"
170		-Class-Object accessor is used from both object and class
171		-.PP
172		-.Vb 2
173		-\& $class->$accessor # call from class
174		-\& $self->$accessor # call form object
175		-.Ve
176		-.Sh "tag_processors"
177		-.IX Subsection "tag_processors"
178		-.Vb 3
179		-\& # Set and get
180		-\& $self = $sql_tmpl->tag_processors($tag_processors);
181		-\& $tag_processors = $sql_tmpl->tag_processors;
182		-.Ve
183		-.PP
184		-.Vb 5
185		-\& # Sample
186		-\& $sql_tmpl->tag_processors(
187		-\& '?' => \e&expand_question,
188		-\& '=' => \e&expand_equel
189		-\& );
190		-.Ve
191		-.PP
192		-You can use add_tag_processor to add tag processor
193		-.Sh "tag_start"
194		-.IX Subsection "tag_start"
195		-.Vb 3
196		-\& # Set and get
197		-\& $self = $sql_tmpl->tag_start($tag_start);
198		-\& $tag_start = $sql_tmpl->tag_start;
199		-.Ve
200		-.PP
201		-.Vb 2
202		-\& # Sample
203		-\& $sql_tmpl->tag_start('{');
204		-.Ve
205		-.PP
206		-Default is '{'
207		-.Sh "tag_end"
208		-.IX Subsection "tag_end"
209		-.Vb 3
210		-\& # Set and get
211		-\& $self = $sql_tmpl->tag_start($tag_end);
212		-\& $tag_end = $sql_tmpl->tag_start;
213		-.Ve
214		-.PP
215		-.Vb 2
216		-\& # Sample
217		-\& $sql_tmpl->tag_start('}');
218		-.Ve
219		-.PP
220		-Default is '}'
221		-.Sh "tag_syntax"
222		-.IX Subsection "tag_syntax"
223		-.Vb 3
224		-\& # Set and get
225		-\& $self = $sql_tmpl->tag_syntax($tag_syntax);
226		-\& $tag_syntax = $sql_tmpl->tag_syntax;
227		-.Ve
228		-.PP
229		-.Vb 7
230		-\& # Sample
231		-\& $sql_tmpl->tag_syntax(
232		-\& "[Tag] [Expand]\en" .
233		-\& "{? name} ?\en" .
234		-\& "{= name} name = ?\en" .
235		-\& "{<> name} name <> ?\en"
236		-\& );
237		-.Ve
238		-.SH "METHODS"
239		-.IX Header "METHODS"
240		-.Sh "create_query"
241		-.IX Subsection "create_query"
242		-.Vb 2
243		-\& # Create SQL form SQL template
244		-\& $query = $sql_tmpl->create_query($tmpl);
245		-.Ve
246		-.PP
247		-.Vb 3
248		-\& # Sample
249		-\& $query = $sql_tmpl->create_sql(
250		-\& "select * from table where {= title} && {like author} \|\| {<= price}")
251		-.Ve
252		-.PP
253		-.Vb 3
254		-\& # Result
255		-\& $qeury->{sql} : "select * from table where title = ? && author like ? price <= ?;"
256		-\& $query->{key_infos} : [['title'], ['author'], ['price']]
257		-.Ve
258		-.PP
259		-.Vb 5
260		-\& # Sample2 (with table name)
261		-\& ($sql, @bind_values) = $sql_tmpl->create_sql(
262		-\& "select * from table where {= table.title} && {like table.author}",
263		-\& {table => {title => 'Perl', author => '%Taro%'}}
264		-\& )
265		-.Ve
266		-.PP
267		-.Vb 4
268		-\& # Result2
269		-\& $query->{sql} : "select * from table where table.title = ? && table.title like ?;"
270		-\& $query->{key_infos} :[ [['table.title'],['table', 'title']],
271		-\& [['table.author'],['table', 'author']] ]
272		-.Ve
273		-.PP
274		-This method create query using by DBIx::Custom.
275		-query is two infomation
276		-.PP
277		-.Vb 2
278		-\& 1.sql : SQL
279		-\& 2.key_infos : Parameter access key information
280		-.Ve
281		-.Sh "add_tag_processor"
282		-.IX Subsection "add_tag_processor"
283		-Add tag processor
284		-.PP
285		-.Vb 2
286		-\& # Add
287		-\& $self = $sql_tmpl->add_tag_processor($tag_processor);
288		-.Ve
289		-.PP
290		-.Vb 4
291		-\& # Sample
292		-\& $sql_tmpl->add_tag_processor(
293		-\& '?' => sub {
294		-\& my ($tag_name, $tag_args) = @_;
295		-.Ve
296		-.PP
297		-.Vb 2
298		-\& my $key1 = $tag_args->[0];
299		-\& my $key2 = $tag_args->[1];
300		-.Ve
301		-.PP
302		-.Vb 1
303		-\& my $key_infos = [];
304		-.Ve
305		-.PP
306		-.Vb 1
307		-\& # Expand tag and create key informations
308		-.Ve
309		-.PP
310		-.Vb 4
311		-\& # Return expand tags and key informations
312		-\& return ($expand, $key_infos);
313		-\& }
314		-\& );
315		-.Ve
316		-.PP
317		-Tag processor recieve 2 argument
318		-.PP
319		-.Vb 2
320		-\& 1. Tag name (?, =, <>, or etc)
321		-\& 2. Tag arguments (arg1 and arg2 in {tag_name arg1 arg2})
322		-.Ve
323		-.PP
324		-Tag processor return 2 value
325		-.PP
326		-.Vb 2
327		-\& 1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?')
328		-\& 2. Key infomations
329		-.Ve
330		-.PP
331		-You must be return expanded tag and key infomations.
332		-.PP
333		-Key information is a little complex. so I will explan this in future.
334		-.PP
335		-If you want to know more, Please see DBIx::Custom::SQL::Template source code.
336		-.Sh "clone"
337		-.IX Subsection "clone"
338		-.Vb 2
339		-\& # Clone DBIx::Custom::SQL::Template object
340		-\& $clone = $self->clone;
341		-.Ve
342		-.SH "Available Tags"
343		-.IX Header "Available Tags"
344		-.Vb 5
345		-\& # Available Tags
346		-\& [tag] [expand]
347		-\& {? name} ?
348		-\& {= name} name = ?
349		-\& {<> name} name <> ?
350		-.Ve
351		-.PP
352		-.Vb 4
353		-\& {< name} name < ?
354		-\& {> name} name > ?
355		-\& {>= name} name >= ?
356		-\& {<= name} name <= ?
357		-.Ve
358		-.PP
359		-.Vb 2
360		-\& {like name} name like ?
361		-\& {in name} name in [?, ?, ..]
362		-.Ve
363		-.PP
364		-.Vb 2
365		-\& {insert} (key1, key2, key3) values (?, ?, ?)
366		-\& {update} set key1 = ?, key2 = ?, key3 = ?
367		-.Ve
368		-.PP
369		-.Vb 6
370		-\& # Sample1
371		-\& $query = $sql_tmpl->create_sql(
372		-\& "insert into table {insert key1 key2}"
373		-\& );
374		-\& # Result1
375		-\& $sql : "insert into table (key1, key2) values (?, ?)"
376		-.Ve
377		-.PP
378		-.Vb 4
379		-\& # Sample2
380		-\& $query = $sql_tmpl->create_sql(
381		-\& "update table {update key1 key2} where {= key3}"
382		-\& );
383		-.Ve
384		-.PP
385		-.Vb 2
386		-\& # Result2
387		-\& $query->{sql} : "update table set key1 = ?, key2 = ? where key3 = ?;"
388		-.Ve
389		-.SH "AUTHOR"
390		-.IX Header "AUTHOR"
391		-Yuki Kimoto, \f(CW\(C`<kimoto.yuki at gmail.com>\(C'\fR
392		-.PP
393		-Github
394		-<http://github.com/yuki\-kimoto>
395		-<http://github.com/yuki\-kimoto/DBIx\-Custom\-SQL\-Template>
396		-.PP
397		-Please let know me bag if you find
398		-Please request me if you want to do something
399		-.SH "COPYRIGHT & LICENSE"
400		-.IX Header "COPYRIGHT & LICENSE"
401		-Copyright 2009 Yuki Kimoto, all rights reserved.
402		-.PP
403		-This program is free software; you can redistribute it and/or modify it
404		-under the same terms as Perl itself.

-229

DBIx-Custom-0.0501/blib/libdoc/DBIx::Custom::SQLite.3pm

View

...	...	@@ -1,229 +0,0 @@
1		-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2		-.\"
3		-.\" Standard preamble:
4		-.\" ========================================================================
5		-.de Sh \" Subsection heading
6		-.br
7		-.if t .Sp
8		-.ne 5
9		-.PP
10		-\fB\\$1\fR
11		-.PP
12		-..
13		-.de Sp \" Vertical space (when we can't use .PP)
14		-.if t .sp .5v
15		-.if n .sp
16		-..
17		-.de Vb \" Begin verbatim text
18		-.ft CW
19		-.nf
20		-.ne \\$1
21		-..
22		-.de Ve \" End verbatim text
23		-.ft R
24		-.fi
25		-..
26		-.\" Set up some character translations and predefined strings. \*(-- will
27		-.\" give an unbreakable dash, \(PI will give pi, \(L" will give a left
28		-.\" double quote, and \*(R" will give a right double quote. \| will give a
29		-.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to
30		-.\" do unbreakable dashes and therefore won't be available. \(C` and \(C'
31		-.\" expand to `' in nroff, nothing in troff, for use with C<>.
32		-.tr \(W-\|\(bv\(Tr
33		-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34		-.ie n \{\
35		-. ds -- \(*W-
36		-. ds PI pi
37		-. if (\n(.H=4u)&(1m=24u) .ds -- \(W\h'-12u'\(W\h'-12u'-\" diablo 10 pitch
38		-. if (\n(.H=4u)&(1m=20u) .ds -- \(W\h'-12u'\(W\h'-8u'-\" diablo 12 pitch
39		-. ds L" ""
40		-. ds R" ""
41		-. ds C` ""
42		-. ds C' ""
43		-'br\}
44		-.el\{\
45		-. ds -- \\|\(em\\|
46		-. ds PI \(*p
47		-. ds L" ``
48		-. ds R" ''
49		-'br\}
50		-.\"
51		-.\" If the F register is turned on, we'll generate index entries on stderr for
52		-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53		-.\" entries marked with X<> in POD. Of course, you'll have to process the
54		-.\" output yourself in some meaningful fashion.
55		-.if \nF \{\
56		-. de IX
57		-. tm Index:\\$1\t\\n%\t"\\$2"
58		-..
59		-. nr % 0
60		-. rr F
61		-.\}
62		-.\"
63		-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
64		-.\" way too many mistakes in technical documents.
65		-.hy 0
66		-.if n .na
67		-.\"
68		-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69		-.\" Fear. Run. Save yourself. No user-serviceable parts.
70		-. \" fudge factors for nroff and troff
71		-.if n \{\
72		-. ds #H 0
73		-. ds #V .8m
74		-. ds #F .3m
75		-. ds #[ \f1
76		-. ds #] \fP
77		-.\}
78		-.if t \{\
79		-. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80		-. ds #V .6m
81		-. ds #F 0
82		-. ds #[ \&
83		-. ds #] \&
84		-.\}
85		-. \" simple accents for nroff and troff
86		-.if n \{\
87		-. ds ' \&
88		-. ds ` \&
89		-. ds ^ \&
90		-. ds , \&
91		-. ds ~ ~
92		-. ds /
93		-.\}
94		-.if t \{\
95		-. ds ' \\k:\h'-(\\n(.wu8/10-\(#H)'\'\h"\|\\n:u"
96		-. ds ` \\k:\h'-(\\n(.wu8/10-\(#H)'\`\h'\|\\n:u'
97		-. ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'^\h'\|\\n:u'
98		-. ds , \\k:\h'-(\\n(.wu*8/10)',\h'\|\\n:u'
99		-. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'\|\\n:u'
100		-. ds / \\k:\h'-(\\n(.wu8/10-\(#H)'\z\(sl\h'\|\\n:u'
101		-.\}
102		-. \" troff and (daisy-wheel) nroff accents
103		-.ds : \\k:\h'-(\\n(.wu8/10-\(#H+.1m+\(#F)'\v'-\(#V'\z.\h'.2m+\(#F'.\h'\|\\n:u'\v'\(#V'
104		-.ds 8 \h'\(#H'\(b\h'-\*(#H'
105		-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\(#H)/2u'\v'-.3n'\(#[\z\(de\v'.3n'\h'\|\\n:u'\*(#]
106		-.ds d- \h'\(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\(#H'
107		-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'\|\\n:u'
108		-.ds th \(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u2/3)'\s-1o\s+1\*(#]
109		-.ds Th \(#[\s+2I\s-2\h'-\w'I'u3/5'\v'-.3m'o\v'.3m'\*(#]
110		-.ds ae a\h'-(\w'a'u*4/10)'e
111		-.ds Ae A\h'-(\w'A'u*4/10)'E
112		-. \" corrections for vroff
113		-.if v .ds ~ \\k:\h'-(\\n(.wu9/10-\(#H)'\s-2\u~\d\s+2\h'\|\\n:u'
114		-.if v .ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'\v'-.4m'^\v'.4m'\h'\|\\n:u'
115		-. \" for low resolution devices (crt and lpr)
116		-.if \n(.H>23 .if \n(.V>19 \
117		-\{\
118		-. ds : e
119		-. ds 8 ss
120		-. ds o a
121		-. ds d- d\h'-1'\(ga
122		-. ds D- D\h'-1'\(hy
123		-. ds th \o'bp'
124		-. ds Th \o'LP'
125		-. ds ae ae
126		-. ds Ae AE
127		-.\}
128		-.rm #[ #] #H #V #F C
129		-.\" ========================================================================
130		-.\"
131		-.IX Title "DBIx::Custom::SQLite 3"
132		-.TH DBIx::Custom::SQLite 3 "2009-11-16" "perl v5.8.8" "User Contributed Perl Documentation"
133		-.SH "NAME"
134		-DBIx::Custom::SQLite \- DBIx::Custom SQLite implementation
135		-.SH "Version"
136		-.IX Header "Version"
137		-Version 0.0201
138		-.SH "Synopsys"
139		-.IX Header "Synopsys"
140		-.Vb 1
141		-\& use DBIx::Custom::SQLite;
142		-.Ve
143		-.PP
144		-.Vb 3
145		-\& # New
146		-\& my $dbi = DBIx::Custom::SQLite->new(user => 'taro', $password => 'kliej&@K',
147		-\& database => 'sample.db');
148		-.Ve
149		-.PP
150		-.Vb 2
151		-\& # Insert
152		-\& $dbi->insert('books', {title => 'perl', author => 'taro'});
153		-.Ve
154		-.PP
155		-.Vb 3
156		-\& # Update
157		-\& # same as 'update books set (title = 'aaa', author = 'ken') where id = 5;
158		-\& $dbi->update('books', {title => 'aaa', author => 'ken'}, {id => 5});
159		-.Ve
160		-.PP
161		-.Vb 2
162		-\& # Delete
163		-\& $dbi->delete('books', {author => 'taro'});
164		-.Ve
165		-.PP
166		-.Vb 2
167		-\& # select * from books;
168		-\& $dbi->select('books');
169		-.Ve
170		-.PP
171		-.Vb 2
172		-\& # select * from books where ahthor = 'taro';
173		-\& $dbi->select('books', {author => 'taro'});
174		-.Ve
175		-.PP
176		-.Vb 2
177		-\& # select author, title from books where author = 'taro'
178		-\& $dbi->select('books', [qw/author title/], {author => 'taro'});
179		-.Ve
180		-.PP
181		-.Vb 3
182		-\& # select author, title from books where author = 'taro' order by id limit 1;
183		-\& $dbi->select('books', [qw/author title/], {author => 'taro'},
184		-\& 'order by id limit 1');
185		-.Ve
186		-.SH "See DBIx::Custom and DBI::Custom::Basic documentation"
187		-.IX Header "See DBIx::Custom and DBI::Custom::Basic documentation"
188		-This class is DBIx::Custom::Basic subclass.
189		-and DBIx::Custom::Basic is DBIx::Custom subclass
190		-.PP
191		-You can use all methods of DBIx::Custom::Basic and <DBIx::Custom>
192		-Please see DBIx::Custom::Basic and <DBIx::Custom> documentation
193		-.SH "Object methods"
194		-.IX Header "Object methods"
195		-.Sh "connect"
196		-.IX Subsection "connect"
197		-This override DBIx::Custom connect.
198		-.PP
199		-.Vb 2
200		-\& # Connect to database
201		-\& $dbi->connect;
202		-.Ve
203		-.PP
204		-If database attribute is set, automatically data source is created and connect
205		-.Sh "connect_memory"
206		-.IX Subsection "connect_memory"
207		-.Vb 2
208		-\& # Connect memory database
209		-\& $self = $dbi->connect_memory;
210		-.Ve
211		-.Sh "reconnect_memory"
212		-.IX Subsection "reconnect_memory"
213		-.Vb 2
214		-\& # Reconnect memory database
215		-\& $self = $dbi->reconnect_memory;
216		-.Ve
217		-.SH "Author"
218		-.IX Header "Author"
219		-Yuki Kimoto, \f(CW\(C`<kimoto.yuki at gmail.com>\(C'\fR
220		-.PP
221		-Github <http://github.com/yuki\-kimoto>
222		-.PP
223		-I develope this module <http://github.com/yuki\-kimoto/DBIx\-Custom>
224		-.SH "Copyright & lisence"
225		-.IX Header "Copyright & lisence"
226		-Copyright 2009 Yuki Kimoto, all rights reserved.
227		-.PP
228		-This program is free software; you can redistribute it and/or modify it
229		-under the same terms as Perl itself.

-1127

DBIx-Custom-0.0501/lib/DBIx/Custom.pm

View

@@ -1,1127 +0,0 @@
-use 5.008001;
-
-package DBIx::Custom;
-use Object::Simple;
-
-our $VERSION = '0.0501';
-
-use Carp 'croak';
-use DBI;
-use DBIx::Custom::Query;
-use DBIx::Custom::Result;
-use DBIx::Custom::SQL::Template;
-
-
-### Class-Object Accessors
-sub user        : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub password    : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub data_source : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub dbi_options : ClassObjectAttr { initialize => {clone => 'hash', 
-                                                   default => sub { {} } } }
-sub database    : ClassObjectAttr { initialize => {clone => 'scalar'} }
-
-sub bind_filter  : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub fetch_filter : ClassObjectAttr { initialize => {clone => 'scalar'} }
-
-sub no_bind_filters   : ClassObjectAttr { initialize => {clone => 'array'} }
-sub no_fetch_filters  : ClassObjectAttr { initialize => {clone => 'array'} }
-
-sub filters : ClassObjectAttr {
-    type => 'hash',
-    deref => 1,
-    initialize => {
-        clone   => 'hash',
-        default => sub { {} }
-    }
-}
-
-sub formats : ClassObjectAttr {
-    type => 'hash',
-    deref => 1,
-    initialize => {
-        clone   => 'hash',
-        default => sub { {} }
-    }
-}
-
-sub result_class : ClassObjectAttr {
-    initialize => {
-        clone   => 'scalar',
-        default => 'DBIx::Custom::Result'
-    }
-}
-
-sub sql_template : ClassObjectAttr {
-    initialize => {
-        clone   => sub {$_[0] ? $_[0]->clone : undef},
-        default => sub {DBIx::Custom::SQL::Template->new}
-    }
-}
-
-### Object Accessor
-sub dbh          : Attr {}
-
-
-### Methods
-
-# Add filter
-sub add_filter {
-    my $invocant = shift;
-    
-    my %old_filters = $invocant->filters;
-    my %new_filters = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
-    $invocant->filters(%old_filters, %new_filters);
-    return $invocant;
-}
-
-# Add format
-sub add_format{
-    my $invocant = shift;
-    
-    my %old_formats = $invocant->formats;
-    my %new_formats = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
-    $invocant->formats(%old_formats, %new_formats);
-    return $invocant;
-}
-
-# Auto commit
-sub _auto_commit {
-    my $self = shift;
-    
-    croak("Not yet connect to database") unless $self->dbh;
-    
-    if (@_) {
-        $self->dbh->{AutoCommit} = $_[0];
-        return $self;
-    }
-    return $self->dbh->{AutoCommit};
-}
-
-# Connect
-sub connect {
-    my $self = shift;
-    my $data_source = $self->data_source;
-    my $user        = $self->user;
-    my $password    = $self->password;
-    my $dbi_options  = $self->dbi_options;
-    
-    my $dbh = eval{DBI->connect(
-        $data_source,
-        $user,
-        $password,
-        {
-            RaiseError => 1,
-            PrintError => 0,
-            AutoCommit => 1,
-            %{$dbi_options || {} }
-        }
-    )};
-    
-    croak $@ if $@;
-    
-    $self->dbh($dbh);
-    return $self;
-}
-
-# DESTROY
-sub DESTROY {
-    my $self = shift;
-    $self->disconnect if $self->connected;
-}
-
-# Is connected?
-sub connected {
-    my $self = shift;
-    return ref $self->{dbh} eq 'DBI::db';
-}
-
-# Disconnect
-sub disconnect {
-    my $self = shift;
-    if ($self->connected) {
-        $self->dbh->disconnect;
-        delete $self->{dbh};
-    }
-}
-
-# Reconnect
-sub reconnect {
-    my $self = shift;
-    $self->disconnect if $self->connected;
-    $self->connect;
-}
-
-# Prepare statement handle
-sub prepare {
-    my ($self, $sql) = @_;
-    
-    # Connect if not
-    $self->connect unless $self->connected;
-    
-    # Prepare
-    my $sth = eval{$self->dbh->prepare($sql)};
-    
-    # Error
-    croak("$@<Your SQL>\n$sql") if $@;
-    
-    return $sth;
-}
-
-# Execute SQL directly
-sub do{
-    my ($self, $sql, @bind_values) = @_;
-    
-    # Connect if not
-    $self->connect unless $self->connected;
-    
-    # Do
-    my $ret_val = eval{$self->dbh->do($sql, @bind_values)};
-    
-    # Error
-    if ($@) {
-        my $error = $@;
-        require Data::Dumper;
-        
-        my $bind_value_dump
-          = Data::Dumper->Dump([\@bind_values], ['*bind_valuds']);
-        
-        croak("$error<Your SQL>\n$sql\n<Your bind values>\n$bind_value_dump\n");
-    }
-}
-
-# Create query
-sub create_query {
-    my ($self, $template) = @_;
-    my $class = ref $self;
-    
-    # Create query from SQL template
-    my $sql_template = $self->sql_template;
-    
-    # Try to get cached query
-    my $query = $class->_query_caches->{$template};
-    
-    # Create query
-    unless ($query) {
-        $query = eval{$sql_template->create_query($template)};
-        croak($@) if $@;
-        
-        $query = DBIx::Custom::Query->new($query);
-        
-        $class->_add_query_cache($template, $query);
-    }
-    
-    # Connect if not
-    $self->connect unless $self->connected;
-    
-    # Prepare statement handle
-    my $sth = $self->prepare($query->{sql});
-    
-    # Set statement handle
-    $query->sth($sth);
-    
-    # Set bind filter
-    $query->bind_filter($self->bind_filter);
-    
-    # Set no filter keys when binding
-    $query->no_bind_filters($self->no_bind_filters);
-    
-    # Set fetch filter
-    $query->fetch_filter($self->fetch_filter);
-    
-    # Set no filter keys when fetching
-    $query->no_fetch_filters($self->no_fetch_filters);
-    
-    return $query;
-}
-
-# Execute query
-sub execute {
-    my ($self, $query, $params)  = @_;
-    $params ||= {};
-    
-    # First argument is SQL template
-    if (!ref $query) {
-        my $template = $query;
-        $query = $self->create_query($template);
-        my $query_edit_cb = $_[3];
-        $query_edit_cb->($query) if ref $query_edit_cb eq 'CODE';
-    }
-    
-    # Create bind value
-    my $bind_values = $self->_build_bind_values($query, $params);
-    
-    # Execute
-    my $sth = $query->sth;
-    my $ret_val = eval{$sth->execute(@$bind_values)};
-    
-    # Execute error
-    if (my $execute_error = $@) {
-        require Data::Dumper;
-        my $sql              = $query->{sql} || '';
-        my $key_infos_dump   = Data::Dumper->Dump([$query->key_infos], ['*key_infos']);
-        my $params_dump      = Data::Dumper->Dump([$params], ['*params']);
-        
-        croak("$execute_error" . 
-              "<Your SQL>\n$sql\n" . 
-              "<Your parameters>\n$params_dump");
-    }
-    
-    # Return resultset if select statement is executed
-    if ($sth->{NUM_OF_FIELDS}) {
-        
-        # Get result class
-        my $result_class = $self->result_class;
-        
-        # Create result
-        my $result = $result_class->new({
-            sth              => $sth,
-            fetch_filter     => $query->fetch_filter,
-            no_fetch_filters => $query->no_fetch_filters
-        });
-        return $result;
-    }
-    return $ret_val;
-}
-
-# Build binding values
-sub _build_bind_values {
-    my ($self, $query, $params) = @_;
-    my $key_infos           = $query->key_infos;
-    my $bind_filter         = $query->bind_filter;
-    my $no_bind_filters_map = $query->_no_bind_filters_map || {};
-    
-    # binding values
-    my @bind_values;
-    
-    # Create bind values
-    KEY_INFOS :
-    foreach my $key_info (@$key_infos) {
-        # Set variable
-        my $access_keys  = $key_info->{access_keys};
-        my $original_key = $key_info->{original_key} || '';
-        my $table        = $key_info->{table}        || '';
-        my $column       = $key_info->{column}       || '';
-        
-        # Key is found?
-        my $found;
-        
-        # Build bind values
-        ACCESS_KEYS :
-        foreach my $access_key (@$access_keys) {
-            # Root parameter
-            my $root_params = $params;
-            
-            # Search corresponding value
-            for (my $i = 0; $i < @$access_key; $i++) {
-                # Current key
-                my $current_key = $access_key->[$i];
-                
-                # Last key
-                if ($i == @$access_key - 1) {
-                    # Key is array reference
-                    if (ref $current_key eq 'ARRAY') {
-                        # Filtering 
-                        if ($bind_filter &&
-                            !$no_bind_filters_map->{$original_key})
-                        {
-                            push @bind_values, 
-                                 $bind_filter->($root_params->[$current_key->[0]], 
-                                                $original_key,
-                                                $table, $column);
-                        }
-                        # Not filtering
-                        else {
-                            push @bind_values,
-                                 scalar $root_params->[$current_key->[0]];
-                        }
-                    }
-                    # Key is string
-                    else {
-                        # Key is not found
-                        next ACCESS_KEYS
-                          unless exists $root_params->{$current_key};
-                        
-                        # Filtering
-                        if ($bind_filter &&
-                            !$no_bind_filters_map->{$original_key}) 
-                        {
-                            push @bind_values,
-                                 $bind_filter->($root_params->{$current_key},
-                                                $original_key,
-                                                $table, $column);
-                        }
-                        # Not filtering
-                        else {
-                            push @bind_values,
-                                 scalar $root_params->{$current_key};
-                        }
-                    }
-                    
-                    # Key is found
-                    $found = 1;
-                    next KEY_INFOS;
-                }
-                # First or middle key
-                else {
-                    # Key is array reference
-                    if (ref $current_key eq 'ARRAY') {
-                        # Go next key
-                        $root_params = $root_params->[$current_key->[0]];
-                    }
-                    # Key is string
-                    else {
-                        # Not found
-                        next ACCESS_KEYS
-                          unless exists $root_params->{$current_key};
-                        
-                        # Go next key
-                        $root_params = $root_params->{$current_key};
-                    }
-                }
-            }
-        }
-        
-        # Key is not found
-        unless ($found) {
-            require Data::Dumper;
-            my $key_info_dump  = Data::Dumper->Dump([$key_info], ['*key_info']);
-            my $params_dump    = Data::Dumper->Dump([$params], ['*params']);
-            croak("Corresponding key is not found in your parameters\n" . 
-                  "<Key information>\n$key_info_dump\n\n" .
-                  "<Your parameters>\n$params_dump\n");
-        }
-    }
-    return \@bind_values;
-}
-
-# Run transaction
-sub run_transaction {
-    my ($self, $transaction) = @_;
-    
-    # Check auto commit
-    croak("AutoCommit must be true before transaction start")
-      unless $self->_auto_commit;
-    
-    # Auto commit off
-    $self->_auto_commit(0);
-    
-    # Run transaction
-    eval {$transaction->()};
-    
-    # Tranzaction error
-    my $transaction_error = $@;
-    
-    # Tranzaction is failed.
-    if ($transaction_error) {
-        # Rollback
-        eval{$self->dbh->rollback};
-        
-        # Rollback error
-        my $rollback_error = $@;
-        
-        # Auto commit on
-        $self->_auto_commit(1);
-        
-        if ($rollback_error) {
-            # Rollback is failed
-            croak("${transaction_error}Rollback is failed : $rollback_error");
-        }
-        else {
-            # Rollback is success
-            croak("${transaction_error}Rollback is success");
-        }
-    }
-    # Tranzaction is success
-    else {
-        # Commit
-        eval{$self->dbh->commit};
-        my $commit_error = $@;
-        
-        # Auto commit on
-        $self->_auto_commit(1);
-        
-        # Commit is failed
-        croak($commit_error) if $commit_error;
-    }
-}
-
-# Get last insert id
-sub last_insert_id {
-    my $self = shift;
-    
-    # Not connected
-    croak("Not yet connect to database")
-      unless $self->connected;
-    
-    return $self->dbh->last_insert_id(@_);
-}
-
-# Insert
-sub insert {
-    my ($self, $table, $insert_params, $query_edit_cb) = @_;
-    $table         ||= '';
-    $insert_params ||= {};
-    
-    # Insert keys
-    my @insert_keys = keys %$insert_params;
-    
-    # Not exists insert keys
-    croak("Key-value pairs for insert must be specified to 'insert' second argument")
-      unless @insert_keys;
-    
-    # Templte for insert
-    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit callback must be code reference
-    croak("Query edit callback must be code reference")
-      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
-    
-    # Query edit if need
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Execute query
-    my $ret_val = $self->execute($query, $insert_params);
-    
-    return $ret_val;
-}
-
-# Update
-sub update {
-    my ($self, $table, $update_params,
-        $where_params, $query_edit_cb, $options) = @_;
-    
-    $table         ||= '';
-    $update_params ||= {};
-    $where_params  ||= {};
-    
-    # Update keys
-    my @update_keys = keys %$update_params;
-    
-    # Not exists update kyes
-    croak("Key-value pairs for update must be specified to 'update' second argument")
-      unless @update_keys;
-    
-    # Where keys
-    my @where_keys = keys %$where_params;
-    
-    # Not exists where keys
-    croak("Key-value pairs for where clause must be specified to 'update' third argument")
-      if !@where_keys && !$options->{allow_update_all};
-    
-    # Update clause
-    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
-    
-    # Where clause
-    my $where_clause = '';
-    if (@where_keys) {
-        $where_clause = 'where ';
-        foreach my $where_key (@where_keys) {
-            $where_clause .= "{= $where_key} and ";
-        }
-        $where_clause =~ s/ and $//;
-    }
-    
-    # Template for update
-    my $template = "update $table $update_clause $where_clause";
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit callback must be code reference
-    croak("Query edit callback must be code reference")
-      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
-    
-    # Query edit if need
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Rearrange parammeters
-    my $params = {'#update' => $update_params, %$where_params};
-    
-    # Execute query
-    my $ret_val = $self->execute($query, $params);
-    
-    return $ret_val;
-}
-
-# Update all rows
-sub update_all {
-    my ($self, $table, $update_params, $query_edit_cb) = @_;
-    
-    return $self->update($table, $update_params, {}, $query_edit_cb,
-                         {allow_update_all => 1});
-}
-
-# Delete
-sub delete {
-    my ($self, $table, $where_params, $query_edit_cb, $options) = @_;
-    $table        ||= '';
-    $where_params ||= {};
-    
-    # Where keys
-    my @where_keys = keys %$where_params;
-    
-    # Not exists where keys
-    croak("Key-value pairs for where clause must be specified to 'delete' second argument")
-      if !@where_keys && !$options->{allow_delete_all};
-    
-    # Where clause
-    my $where_clause = '';
-    if (@where_keys) {
-        $where_clause = 'where ';
-        foreach my $where_key (@where_keys) {
-            $where_clause .= "{= $where_key} and ";
-        }
-        $where_clause =~ s/ and $//;
-    }
-    
-    # Template for delete
-    my $template = "delete from $table $where_clause";
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit callback must be code reference
-    croak("Query edit callback must be code reference")
-      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
-    
-    # Query edit if need
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Execute query
-    my $ret_val = $self->execute($query, $where_params);
-    
-    return $ret_val;
-}
-
-# Delete all rows
-sub delete_all {
-    my ($self, $table) = @_;
-    return $self->delete($table, {}, undef, {allow_delete_all => 1});
-}
-
-sub _select_usage { return << 'EOS' }
-Your select arguments is wrong.
-select usage:
-$dbi->select(
-    $table,                # must be string or array ref
-    [@$columns],           # must be array reference. this is optional
-    {%$where_params},      # must be hash reference.  this is optional
-    $append_statement,     # must be string.          this is optional
-    $query_edit_callback   # must be code reference.  this is optional
-);
-EOS
-
-sub select {
-    my $self = shift;
-    
-    # Check argument
-    croak($self->_select_usage) unless @_;
-    
-    # Arguments
-    my $tables = shift || '';
-    $tables    = [$tables] unless ref $tables;
-    
-    my $columns          = ref $_[0] eq 'ARRAY' ? shift : [];
-    my $where_params     = ref $_[0] eq 'HASH'  ? shift : {};
-    my $append_statement = $_[0] && !ref $_[0]  ? shift : '';
-    my $query_edit_cb    = shift if ref $_[0] eq 'CODE';
-    
-    # Check rest argument
-    croak($self->_select_usage) if @_;
-    
-    # SQL template for select statement
-    my $template = 'select ';
-    
-    # Join column clause
-    if (@$columns) {
-        foreach my $column (@$columns) {
-            $template .= "$column, ";
-        }
-        $template =~ s/, $/ /;
-    }
-    else {
-        $template .= '* ';
-    }
-    
-    # Join table
-    $template .= 'from ';
-    foreach my $table (@$tables) {
-        $template .= "$table, ";
-    }
-    $template =~ s/, $/ /;
-    
-    # Where clause keys
-    my @where_keys = keys %$where_params;
-    
-    # Join where clause
-    if (@where_keys) {
-        $template .= 'where ';
-        foreach my $where_key (@where_keys) {
-            $template .= "{= $where_key} and ";
-        }
-    }
-    $template =~ s/ and $//;
-    
-    # Append something to last of statement
-    if ($append_statement =~ s/^where //) {
-        if (@where_keys) {
-            $template .= " and $append_statement";
-        }
-        else {
-            $template .= " where $append_statement";
-        }
-    }
-    else {
-        $template .= " $append_statement";
-    }
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Execute query
-    my $result = $self->execute($query, $where_params);
-    
-    return $result;
-}
-
-sub _query_caches     : ClassAttr { type => 'hash',
-                                    auto_build => sub {shift->_query_caches({}) } }
-                                    
-sub _query_cache_keys : ClassAttr { type => 'array',
-                                    auto_build => sub {shift->_query_cache_keys([])} }
-                                    
-sub query_cache_max   : ClassAttr { auto_build => sub {shift->query_cache_max(50)} }
-
-# Add query cahce
-sub _add_query_cache {
-    my ($class, $template, $query) = @_;
-    my $query_cache_keys = $class->_query_cache_keys;
-    my $query_caches     = $class->_query_caches;
-    
-    return $class if $query_caches->{$template};
-    
-    $query_caches->{$template} = $query;
-    push @$query_cache_keys, $template;
-    
-    my $overflow = @$query_cache_keys - $class->query_cache_max;
-    
-    for (my $i = 0; $i < $overflow; $i++) {
-        my $template = shift @$query_cache_keys;
-        delete $query_caches->{$template};
-    }
-    
-    return $class;
-}
-
-# Both bind_filter and fetch_filter off
-sub filter_off {
-    my $self = shift;
-    
-    # filter off
-    $self->bind_filter(undef);
-    $self->fetch_filter(undef);
-    
-    return $self;
-}
-
-Object::Simple->build_class;
-
-=head1 NAME
-
-DBIx::Custom - Customizable simple DBI
-
-=head1 VERSION
-
-Version 0.0501
-
-=head1 CAUTION
-
-This module is now experimental stage.
-
-I want you to try this module
-because I want this module stable, and not to damage your DB data by this module bug.
-
-Please tell me bug if you find
-
-=head1 SYNOPSIS
-
-  my $dbi = DBIx::Custom->new;
-  
-  my $query = $dbi->create_query($template);
-  $dbi->execute($query);
-
-=head1 CLASS-OBJECT ACCESSORS
-
-=head2 user
-
-    # Set and get database user name
-    $self = $dbi->user($user);
-    $user = $dbi->user;
-    
-    # Sample
-    $dbi->user('taro');
-
-=head2 password
-
-    # Set and get database password
-    $self     = $dbi->password($password);
-    $password = $dbi->password;
-    
-    # Sample
-    $dbi->password('lkj&le`@s');
-
-=head2 data_source
-
-    # Set and get database data source
-    $self        = $dbi->data_source($data_soruce);
-    $data_source = $dbi->data_source;
-    
-    # Sample(SQLite)
-    $dbi->data_source(dbi:SQLite:dbname=$database);
-    
-    # Sample(MySQL);
-    $dbi->data_source("dbi:mysql:dbname=$database");
-    
-    # Sample(PostgreSQL)
-    $dbi->data_source("dbi:Pg:dbname=$database");
-    
-=head2 database
-
-    # Set and get database name
-    $self     = $dbi->database($database);
-    $database = $dbi->database;
-
-This method will be used in subclass connect method.
-
-=head2 dbi_options
-
-    # Set and get DBI option
-    $self       = $dbi->dbi_options({$options => $value, ...});
-    $dbi_options = $dbi->dbi_options;
-
-    # Sample
-    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
-
-dbi_options is used when you connect database by using connect.
-
-=head2 prepare
-
-    $sth = $dbi->prepare($sql);
-
-This method is same as DBI::prepare
-
-=head2 do
-
-    $dbi->do($sql, @bind_values);
-
-This method is same as DBI::do
-
-=head2 sql_template
-
-    # Set and get SQL::Template object
-    $self         = $dbi->sql_template($sql_template);
-    $sql_template = $dbi->sql_template;
-    
-    # Sample
-    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
-
-=head2 filters
-
-    # Set and get filters
-    $self    = $dbi->filters($filters);
-    $filters = $dbi->filters;
-
-=head2 formats
-
-    # Set and get formats
-    $self    = $dbi->formats($formats);
-    $formats = $dbi->formats;
-    
-=head2 bind_filter
-
-    # Set and get binding filter
-    $self        = $dbi->bind_filter($bind_filter);
-    $bind_filter = $dbi->bind_filter
-
-    # Sample
-    $dbi->bind_filter($self->filters->{default_bind_filter});
-    
-
-you can get DBI database handle if you need.
-
-=head2 fetch_filter
-
-    # Set and get Fetch filter
-    $self         = $dbi->fetch_filter($fetch_filter);
-    $fetch_filter = $dbi->fetch_filter;
-
-    # Sample
-    $dbi->fetch_filter($self->filters->{default_fetch_filter});
-
-=head2 no_bind_filters
-
-    # Set and get no filter keys when binding
-    $self            = $dbi->no_bind_filters($no_bind_filters);
-    $no_bind_filters = $dbi->no_bind_filters;
-
-=head2 no_fetch_filters
-
-    # Set and get no filter keys when fetching
-    $self             = $dbi->no_fetch_filters($no_fetch_filters);
-    $no_fetch_filters = $dbi->no_fetch_filters;
-
-=head2 result_class
-
-    # Set and get resultset class
-    $self         = $dbi->result_class($result_class);
-    $result_class = $dbi->result_class;
-    
-    # Sample
-    $dbi->result_class('DBIx::Custom::Result');
-
-=head2 dbh
-
-    # Get database handle
-    $dbh = $self->dbh;
-
-=head1 METHODS
-
-=head2 connect
-
-    # Connect to database
-    $self = $dbi->connect;
-    
-    # Sample
-    $dbi = DBIx::Custom->new(user => 'taro', password => 'lji8(', 
-                            data_soruce => "dbi:mysql:dbname=$database");
-    $dbi->connect;
-
-=head2 disconnect
-
-    # Disconnect database
-    $dbi->disconnect;
-
-If database is already disconnected, this method do noting.
-
-=head2 reconnect
-
-    # Reconnect
-    $dbi->reconnect;
-
-=head2 connected
-
-    # Check connected
-    $dbi->connected
-    
-=head2 filter_off
-
-    # bind_filter and fitch_filter off
-    $self->filter_off;
-    
-This is equeal to
-    
-    $self->bind_filter(undef);
-    $self->fetch_filter(undef);
-
-=head2 add_filter
-
-    # Add filter (hash ref or hash can be recieve)
-    $self = $dbi->add_filter({$filter_name => $filter, ...});
-    $self = $dbi->add_filter($filetr_name => $filter, ...);
-    
-    # Sample
-    $dbi->add_filter(
-        decode_utf8 => sub {
-            my ($key, $value, $table, $column) = @_;
-            return Encode::decode('UTF-8', $value);
-        },
-        datetime_to_string => sub {
-            my ($key, $value, $table, $column) = @_;
-            return $value->strftime('%Y-%m-%d %H:%M:%S')
-        },
-        default_bind_filter => sub {
-            my ($key, $value, $table, $column) = @_;
-            if (ref $value eq 'Time::Piece') {
-                return $dbi->filters->{datetime_to_string}->($value);
-            }
-            else {
-                return $dbi->filters->{decode_utf8}->($value);
-            }
-        },
-        
-        encode_utf8 => sub {
-            my ($key, $value) = @_;
-            return Encode::encode('UTF-8', $value);
-        },
-        string_to_datetime => sub {
-            my ($key, $value) = @_;
-            return DateTime::Format::MySQL->parse_datetime($value);
-        },
-        default_fetch_filter => sub {
-            my ($key, $value, $type, $sth, $i) = @_;
-            if ($type eq 'DATETIME') {
-                return $dbi->filters->{string_to_datetime}->($value);
-            }
-            else {
-                return $dbi->filters->{encode_utf8}->($value);
-            }
-        }
-    );
-
-add_filter add filter to filters
-
-=head2 add_format
-
-    $dbi->add_format(date => '%Y:%m:%d');
-
-=head2 create_query
-    
-    # Create Query object from SQL template
-    my $query = $dbi->create_query($template);
-    
-=head2 execute
-
-    # Parse SQL template and execute SQL
-    $result = $dbi->query($query, $params);
-    $result = $dbi->query($template, $params); # Shorcut
-    
-    # Sample
-    $result = $dbi->query("select * from authors where {= name} and {= age}", 
-                          {author => 'taro', age => 19});
-    
-    while (my @row = $result->fetch) {
-        # do something
-    }
-
-See also L<DBIx::Custom::SQL::Template>
-
-=head2 run_transaction
-
-    # Run transaction
-    $dbi->run_transaction(sub {
-        # do something
-    });
-
-If transaction is success, commit is execute. 
-If tranzation is died, rollback is execute.
-
-=head2 insert
-
-    # Insert
-    $dbi->insert($table, $insert_values);
-    
-    # Sample
-    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
-
-=head2 update
-
-    # Update
-    $dbi->update($table, $update_values, $where);
-    
-    # Sample
-    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
-
-=head2 update_all
-
-    # Update all rows
-    $dbi->update($table, $updat_values);
-
-=head2 delete
-
-    # Delete
-    $dbi->delete($table, $where);
-    
-    # Sample
-    $dbi->delete('Books', {id => 5});
-
-=head2 delete_all
-
-    # Delete all rows
-    $dbi->delete_all($table);
-
-=head2 last_insert_id
-
-    # Get last insert id
-    $last_insert_id = $dbi->last_insert_id;
-    
-This method is same as DBI last_insert_id;
-
-=head2 select
-    
-    # Select
-    $dbi->select(
-        $table,                # must be string or array;
-        [@$columns],           # must be array reference. this is optional
-        {%$where_params},      # must be hash reference.  this is optional
-        $append_statement,     # must be string.          this is optional
-        $query_edit_callback   # must be code reference.  this is optional
-    );
-    
-    # Sample
-    $dbi->select(
-        'Books',
-        ['title', 'author'],
-        {id => 1},
-        "for update",
-        sub {
-            my $query = shift;
-            $query->bind_filter(sub {
-                # ...
-            });
-        }
-    );
-    
-    # The way to join multi tables
-    $dbi->select(
-        ['table1', 'table2'],
-        ['table1.id as table1_id', 'title'],
-        {table1.id => 1},
-        "where table1.id = table2.id",
-    );
-
-=head1 Class Accessors
-
-=head2 query_cache_max
-
-    # Max query cache count
-    $class           = $class->query_cache_max($query_cache_max);
-    $query_cache_max = $class->query_cache_max;
-    
-    # Sample
-    DBIx::Custom->query_cache_max(50);
-
-=head1 CAUTION
-
-DBIx::Custom have DIB object internal.
-This module is work well in the following DBI condition.
-
-    1. AutoCommit is true
-    2. RaiseError is true
-
-By default, Both AutoCommit and RaiseError is true.
-You must not change these mode not to damage your data.
-
-If you change these mode, 
-you cannot get correct error message, 
-or run_transaction may fail.
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut

-117

DBIx-Custom-0.0501/lib/DBIx/Custom/Basic.pm

View

@@ -1,117 +0,0 @@
-package DBIx::Custom::Basic;
-use 5.008001;
-use base 'DBIx::Custom';
-use Encode qw/decode encode/;
-
-use warnings;
-use strict;
-
-my $class = __PACKAGE__;
-
-$class->add_filter(
-    encode_utf8 => sub {
-        my $value = shift;
-        utf8::upgrade($value) unless Encode::is_utf8($value);
-        return encode('UTF-8', $value);
-    },
-    decode_utf8 => sub { decode('UTF-8', shift) }
-);
-
-$class->add_format(
-    'SQL99_date'        => '%Y-%m-%d',
-    'SQL99_datetime'    => '%Y-%m-%d %H:%M:%S',
-    'SQL99_time'        => '%H:%M:%S',
-    'ISO-8601_date'     => '%Y-%m-%d',
-    'ISO-8601_datetime' => '%Y-%m-%dT%H:%M:%S',
-    'ISO-8601_time'     => '%H:%M:%S',
-);
-
-# Methods
-sub utf8_filter_on {
-    my $self = shift;
-    $self->bind_filter($self->filters->{encode_utf8});
-    $self->fetch_filter($self->filters->{decode_utf8});
-}
-
-1;
-
-=head1 NAME
-
-DBIx::Custom::Basic - DBIx::Custom basic implementation
-
-=head1 Version
-
-Version 0.0201
-
-=head1 See DBIx::Custom documentation
-
-This class is L<DBIx::Custom> subclass.
-
-You can use all methods of L<DBIx::Custom>
-
-Please see L<DBIx::Custom> documentation
-
-=head1 Filters
-
-=head2 encode_utf8
-
-    # Encode to UTF-8 byte stream (utf8::upgrade is done if need)
-    $dbi->filters->{encode_utf8}->($value);
-    
-This filter is generally used as bind filter
-
-    $dbi->bind_filter($dbi->filters->{encode_utf8});
-
-=head2 decode_utf8
-
-    # Decode to perl internal string
-    $dbi->filters->{decode_utf8}->($value);
-    
-This filter is generally used as fetch filter
-
-    $dbi->fetch_filter($dbi->filters->{decode_utf8});
-
-=head2 Formats
-    
-strptime formats is available
-    
-    # format name        format
-    'SQL99_date'         '%Y-%m-%d',
-    'SQL99_datetime'     '%Y-%m-%d %H:%M:%S',
-    'SQL99_time'         '%H:%M:%S',
-    'ISO-8601_date'      '%Y-%m-%d',
-    'ISO-8601_datetime'  '%Y-%m-%dT%H:%M:%S',
-    'ISO-8601_time'      '%H:%M:%S',
-
-You get format as the following
-
-    my $format = $dbi->formats->{$format_name};
-
-=head1 Methods
-
-=head2 utf8_filter_on
-
-    # Encode and decode utf8 filter on
-    $dbi->utf8_filter_on;
-
-This equel to
-
-    $dbi->bind_filter($dbi->filters->{encode_utf8});
-    $dbi->fetch_filter($dbi->filters->{decode_utf8});
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut

-101

DBIx-Custom-0.0501/lib/DBIx/Custom/Query.pm

View

@@ -1,101 +0,0 @@
-package DBIx::Custom::Query;
-use Object::Simple;
-
-sub sql             : Attr {}
-sub key_infos       : Attr {}
-sub bind_filter     : Attr {}
-sub fetch_filter     : Attr {}
-sub sth             : Attr {}
-
-sub no_bind_filters      : Attr { type => 'array', trigger => sub {
-    my $self = shift;
-    my $no_bind_filters = $self->no_bind_filters || [];
-    my %no_bind_filters_map = map {$_ => 1} @{$no_bind_filters};
-    $self->_no_bind_filters_map(\%no_bind_filters_map);
-}}
-sub _no_bind_filters_map : Attr {default => sub { {} }}
-
-sub no_fetch_filters     : Attr { type => 'array', default => sub { [] } }
-
-Object::Simple->build_class;
-
-=head1 NAME
-
-DBIx::Custom::Query - Query object for DBIx::Custom
-
-=head1 VERSION
-
-Version 0.0101
-
-=head1 SYNOPSIS
-
-    # Create query
-    my $dbi = DBIx::Custom->new;
-    my $query = $dbi->create_query($template);
-    
-    # Set query attributes
-    $query->bind_filter($dbi->filters->{default_bind_filter});
-    $query->no_bind_filters('title', 'author');
-    
-    $query->fetch_filter($dbi->filters->{default_fetch_filter});
-    $query->no_fetch_filters('title', 'author');
-    
-    # Execute query
-    $dbi->execute($query, $params);
-
-=head1 OBJECT ACCESSORS
-
-=head2 sth
-
-    # Set and get statement handle
-    $self = $query->sth($sql);
-    $sth  = $query->sth;
-
-=head2 sql
-
-    # Set and get SQL
-    $self = $query->sql($sql);
-    $sql  = $query->sql;
-
-=head2 bind_filter
-
-    # Set and get bind filter
-    $self        = $query->bind_filter($bind_filter);
-    $bind_filter = $query->bind_filter;
-
-=head2 no_bind_filters
-
-    # Set and get keys of no filtering
-    $self            = $query->no_bind_filters($no_filters);
-    $no_bind_filters = $query->no_bind_filters;
-
-=head2 fetch_filter
-
-    # Set and get fetch filter
-    $self        = $query->fetch_filter($fetch_filter);
-    $fetch_filter = $query->fetch_filter;
-
-=head2 no_fetch_filters
-
-    # Set and get keys of no filtering
-    $self            = $query->no_fetch_filters($no_filters);
-    $no_fetch_filters = $query->no_fetch_filters;
-
-=head2 key_infos
-
-    # Set and get key informations
-    $self      = $query->key_infos($key_infos);
-    $key_infos = $query->key_infos;
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.

-384

DBIx-Custom-0.0501/lib/DBIx/Custom/Result.pm

View

@@ -1,384 +0,0 @@
-package DBIx::Custom::Result;
-use Object::Simple;
-use strict;
-use warnings;
-use Carp 'croak';
-
-# Attributes
-sub sth              : Attr {}
-sub fetch_filter     : Attr {}
-sub no_fetch_filters      : Attr { type => 'array', trigger => sub {
-    my $self = shift;
-    my $no_fetch_filters = $self->no_fetch_filters || [];
-    my %no_fetch_filters_map = map {$_ => 1} @{$no_fetch_filters};
-    $self->_no_fetch_filters_map(\%no_fetch_filters_map);
-}}
-sub _no_fetch_filters_map : Attr {default => sub { {} }}
-
-# Fetch (array)
-sub fetch {
-    my ($self, $type) = @_;
-    my $sth = $self->sth;
-    my $fetch_filter = $self->fetch_filter;
-    
-    # Fetch
-    my $row = $sth->fetchrow_arrayref;
-    
-    # Cannot fetch
-    return unless $row;
-    
-    # Filter
-    if ($fetch_filter) {
-        my $keys  = $sth->{NAME_lc};
-        my $types = $sth->{TYPE};
-        for (my $i = 0; $i < @$keys; $i++) {
-            next if $self->_no_fetch_filters_map->{$keys->[$i]};
-            $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $types->[$i],
-                                        $sth, $i);
-        }
-    }
-    return wantarray ? @$row : $row;
-}
-
-# Fetch (hash)
-sub fetch_hash {
-    my $self = shift;
-    my $sth = $self->sth;
-    my $fetch_filter = $self->fetch_filter;
-    
-    # Fetch
-    my $row = $sth->fetchrow_arrayref;
-    
-    # Cannot fetch
-    return unless $row;
-    
-    # Keys
-    my $keys  = $sth->{NAME_lc};
-    
-    # Filter
-    my $row_hash = {};
-    if ($fetch_filter) {
-        my $types = $sth->{TYPE};
-        for (my $i = 0; $i < @$keys; $i++) {
-            if ($self->_no_fetch_filters_map->{$keys->[$i]}) {
-                $row_hash->{$keys->[$i]} = $row->[$i];
-            }
-            else {
-                $row_hash->{$keys->[$i]}
-                  = $fetch_filter->($row->[$i], $keys->[$i],
-                                    $types->[$i], $sth, $i);
-            }
-        }
-    }
-    
-    # No filter
-    else {
-        for (my $i = 0; $i < @$keys; $i++) {
-            $row_hash->{$keys->[$i]} = $row->[$i];
-        }
-    }
-    return wantarray ? %$row_hash : $row_hash;
-}
-
-# Fetch only first (array)
-sub fetch_first {
-    my $self = shift;
-    
-    # Fetch
-    my $row = $self->fetch;
-    
-    # Not exist
-    return unless $row;
-    
-    # Finish statement handle
-    $self->finish;
-    
-    return wantarray ? @$row : $row;
-}
-
-# Fetch only first (hash)
-sub fetch_hash_first {
-    my $self = shift;
-    
-    # Fetch hash
-    my $row = $self->fetch_hash;
-    
-    # Not exist
-    return unless $row;
-    
-    # Finish statement handle
-    $self->finish;
-    
-    return wantarray ? %$row : $row;
-}
-
-# Fetch multi rows (array)
-sub fetch_rows {
-    my ($self, $count) = @_;
-    
-    # Not specified Row count
-    croak("Row count must be specified")
-      unless $count;
-    
-    # Fetch multi rows
-    my $rows = [];
-    for (my $i = 0; $i < $count; $i++) {
-        my @row = $self->fetch;
-        
-        last unless @row;
-        
-        push @$rows, \@row;
-    }
-    
-    return unless @$rows;
-    return wantarray ? @$rows : $rows;
-}
-
-# Fetch multi rows (hash)
-sub fetch_hash_rows {
-    my ($self, $count) = @_;
-    
-    # Not specified Row count
-    croak("Row count must be specified")
-      unless $count;
-    
-    # Fetch multi rows
-    my $rows = [];
-    for (my $i = 0; $i < $count; $i++) {
-        my %row = $self->fetch_hash;
-        
-        last unless %row;
-        
-        push @$rows, \%row;
-    }
-    
-    return unless @$rows;
-    return wantarray ? @$rows : $rows;
-}
-
-
-# Fetch all (array)
-sub fetch_all {
-    my $self = shift;
-    
-    my $rows = [];
-    while(my @row = $self->fetch) {
-        push @$rows, [@row];
-    }
-    return wantarray ? @$rows : $rows;
-}
-
-# Fetch all (hash)
-sub fetch_hash_all {
-    my $self = shift;
-    
-    my $rows = [];
-    while(my %row = $self->fetch_hash) {
-        push @$rows, {%row};
-    }
-    return wantarray ? @$rows : $rows;
-}
-
-# Finish
-sub finish { shift->sth->finish }
-
-# Error
-sub error { 
-    my $self = shift;
-    my $sth  = $self->sth;
-    return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr;
-}
-
-Object::Simple->build_class;
-
-=head1 NAME
-
-DBIx::Custom::Result - Resultset for DBIx::Custom
-
-=head1 VERSION
-
-Version 0.0301
-
-=head1 SYNOPSIS
-
-    # $result is DBIx::Custom::Result object
-    my $dbi = DBIx::Custom->new;
-    my $result = $dbi->query($sql_template, $param);
-    
-    while (my ($val1, $val2) = $result->fetch) {
-        # do something
-    }
-
-=head1 OBJECT ACCESSORS
-
-=head2 sth
-
-    # Set and Get statement handle
-    $self = $result->sth($sth);
-    $sth  = $reuslt->sth
-
-Statement handle is automatically set by DBIx::Custom.
-so you do not set statement handle.
-
-If you need statement handle, you can get statement handle by using this method.
-
-=head2 fetch_filter
-
-    # Set and Get fetch filter
-    $self         = $result->fetch_filter($sth);
-    $fetch_filter = $result->fech_filter;
-
-Statement handle is automatically set by DBIx::Custom.
-If you want to set your fetch filter, you set it.
-
-=head2 no_fetch_filters
-
-    # Set and Get no filter keys when fetching
-    $self             = $result->no_fetch_filters($no_fetch_filters);
-    $no_fetch_filters = $result->no_fetch_filters;
-
-=head1 METHODS
-
-=head2 fetch
-
-    # Fetch row as array reference (Scalar context)
-    $row = $result->fetch;
-    
-    # Fetch row as array (List context)
-    @row = $result->fecth
-
-    # Sample
-    while (my $row = $result->fetch) {
-        # do something
-        my $val1 = $row->[0];
-        my $val2 = $row->[1];
-    }
-
-fetch method is fetch resultset and get row as array or array reference.
-
-=head2 fetch_hash
-
-    # Fetch row as hash reference (Scalar context)
-    $row = $result->fetch_hash;
-    
-    # Fetch row as hash (List context)
-    %row = $result->fecth_hash
-
-    # Sample
-    while (my $row = $result->fetch_hash) {
-        # do something
-        my $val1 = $row->{key1};
-        my $val2 = $row->{key2};
-    }
-
-fetch_hash method is fetch resultset and get row as hash or hash reference.
-
-=head2 fetch_first
-
-    # Fetch only first (Scalar context)
-    $row = $result->fetch_first;
-    
-    # Fetch only first (List context)
-    @row = $result->fetch_first;
-    
-This method fetch only first and finish statement handle
-
-=head2 fetch_hash_first
-    
-    # Fetch only first as hash (Scalar context)
-    $row = $result->fetch_hash_first;
-    
-    # Fetch only first as hash (Scalar context)
-    @row = $result->fetch_hash_first;
-    
-This method fetch only first and finish statement handle
-
-=head2 fetch_rows
-
-    # Fetch multi rows (Scalar context)
-    $rows = $result->fetch_rows($row_count);
-    
-    # Fetch multi rows (List context)
-    @rows = $result->fetch_rows($row_count);
-    
-    # Sapmle 
-    $rows = $result->fetch_rows(10);
-
-=head2 fetch_hash_rows
-
-    # Fetch multi rows as hash (Scalar context)
-    $rows = $result->fetch_hash_rows($row_count);
-    
-    # Fetch multi rows as hash (List context)
-    @rows = $result->fetch_hash_rows($row_count);
-    
-    # Sapmle 
-    $rows = $result->fetch_hash_rows(10);
-
-=head2 fetch_all
-
-    # Fetch all row as array ref of array ref (Scalar context)
-    $rows = $result->fetch_all;
-    
-    # Fetch all row as array of array ref (List context)
-    @rows = $result->fecth_all;
-
-    # Sample
-    my $rows = $result->fetch_all;
-    my $val0_0 = $rows->[0][0];
-    my $val1_1 = $rows->[1][1];
-
-fetch_all method is fetch resultset and get all rows as array or array reference.
-
-=head2 fetch_hash_all
-
-    # Fetch all row as array ref of hash ref (Scalar context)
-    $rows = $result->fetch_hash_all;
-    
-    # Fetch all row as array of hash ref (List context)
-    @rows = $result->fecth_all_hash;
-
-    # Sample
-    my $rows = $result->fetch_hash_all;
-    my $val0_key1 = $rows->[0]{key1};
-    my $val1_key2 = $rows->[1]{key2};
-
-=head2 error
-
-    # Get error infomation
-    $error_messege = $result->error;
-    ($error_message, $error_number, $error_state) = $result->error;
-
-You can get get information. This is crenspond to the following.
-
-    $error_message : $result->sth->errstr
-    $error_number  : $result->sth->err
-    $error_state   : $result->sth->state
-
-=head2 finish
-
-    # Finish statement handle
-    $result->finish
-    
-    # Sample
-    my $row = $reuslt->fetch; # fetch only one row
-    $result->finish
-
-You can finish statement handle.This is equel to
-
-    $result->sth->finish;
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut

-694

DBIx-Custom-0.0501/lib/DBIx/Custom/SQL/Template.pm

View

@@ -1,694 +0,0 @@
-package DBIx::Custom::SQL::Template;
-use Object::Simple;
-
-use Carp 'croak';
-
-# Accessor is created by Object::Simple. Please read Object::Simple document
-
-### Class-Object accessors
-
-# Tag start
-sub tag_start   : ClassObjectAttr {
-    initialize => {default => '{', clone => 'scalar'}
-}
-
-# Tag end
-sub tag_end     : ClassObjectAttr {
-    initialize => {default => '}', clone => 'scalar'}
-}
-
-# Tag syntax
-sub tag_syntax  : ClassObjectAttr {
-    initialize => {default => <<'EOS', clone => 'scalar'}}
-[tag]                     [expand]
-{? name}                  ?
-{= name}                  name = ?
-{<> name}                 name <> ?
-
-{< name}                  name < ?
-{> name}                  name > ?
-{>= name}                 name >= ?
-{<= name}                 name <= ?
-
-{like name}               name like ?
-{in name number}          name in [?, ?, ..]
-
-{insert key1 key2} (key1, key2) values (?, ?)
-{update key1 key2}    set key1 = ?, key2 = ?
-EOS
-
-# Tag processors
-sub tag_processors : ClassObjectAttr {
-    type => 'hash',
-    deref => 1,
-    initialize => {
-        clone => 'hash', 
-        default => sub {{
-            '?'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '='             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '<>'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '>'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '<'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '>='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '<='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            'like'          => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            'in'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_in_tag,
-            'insert'        => \&DBIx::Custom::SQL::Template::TagProcessor::expand_insert_tag,
-            'update'    => \&DBIx::Custom::SQL::Template::TagProcessor::expand_update_tag
-        }}
-    }
-}
-
-# Add Tag processor
-sub add_tag_processor {
-    my $invocant = shift;
-    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
-    $invocant->tag_processors(%{$invocant->tag_processors}, %{$tag_processors});
-    return $invocant;
-}
-
-# Clone
-sub clone {
-    my $self = shift;
-    my $new = $self->new;
-    
-    $new->tag_start($self->tag_start);
-    $new->tag_end($self->tag_end);
-    $new->tag_syntax($self->tag_syntax);
-    $new->tag_processors({%{$self->tag_processors || {}}});
-    
-    return $new;
-}
-
-
-### Object Methods
-
-# Create Query
-sub create_query {
-    my ($self, $template)  = @_;
-    
-    # Parse template
-    my $tree = $self->_parse_template($template);
-    
-    # Build query
-    my $query = $self->_build_query($tree);
-    
-    return $query;
-}
-
-# Parse template
-sub _parse_template {
-    my ($self, $template) = @_;
-    $template ||= '';
-    
-    my $tree = [];
-    
-    # Tags
-    my $tag_start = quotemeta $self->tag_start;
-    my $tag_end   = quotemeta $self->tag_end;
-    
-    # Tokenize
-    my $state = 'text';
-    
-    # Save original template
-    my $original_template = $template;
-    
-    # Parse template
-    while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {
-        my $text = $1;
-        my $tag  = $2;
-        
-        # Parse tree
-        push @$tree, {type => 'text', tag_args => [$text]} if $text;
-        
-        if ($tag) {
-            # Get tag name and arguments
-            my ($tag_name, @tag_args) = split /\s+/, $tag;
-            
-            # Tag processor is exist?
-            unless ($self->tag_processors->{$tag_name}) {
-                my $tag_syntax = $self->tag_syntax;
-                croak("Tag '{$tag}' in SQL template is not exist.\n\n" .
-                      "<SQL template tag syntax>\n" .
-                      "$tag_syntax\n" .
-                      "<Your SQL template>\n" .
-                      "$original_template\n\n");
-            }
-            
-            # Check tag arguments
-            foreach my $tag_arg (@tag_args) {
-                # Cannot cantain placehosder '?'
-                croak("Tag '{t }' arguments cannot contain '?'")
-                  if $tag_arg =~ /\?/;
-            }
-            
-            # Add tag to parsing tree
-            push @$tree, {type => 'tag', tag_name => $tag_name, tag_args => [@tag_args]};
-        }
-    }
-    
-    # Add text to parsing tree 
-    push @$tree, {type => 'text', tag_args => [$template]} if $template;
-    
-    return $tree;
-}
-
-# Build SQL from parsing tree
-sub _build_query {
-    my ($self, $tree) = @_;
-    
-    # SQL
-    my $sql = '';
-    
-    # All parameter key infomation
-    my $all_key_infos = [];
-    
-    # Build SQL 
-    foreach my $node (@$tree) {
-        
-        # Get type, tag name, and arguments
-        my $type     = $node->{type};
-        my $tag_name = $node->{tag_name};
-        my $tag_args = $node->{tag_args};
-        
-        # Text
-        if ($type eq 'text') {
-            # Join text
-            $sql .= $tag_args->[0];
-        }
-        
-        # Tag
-        elsif ($type eq 'tag') {
-            
-            # Get tag processor
-            my $tag_processor = $self->tag_processors->{$tag_name};
-            
-            # Tag processor is code ref?
-            croak("Tag processor '$tag_name' must be code reference")
-              unless ref $tag_processor eq 'CODE';
-            
-            # Expand tag using tag processor
-            my ($expand, $key_infos)
-              = $tag_processor->($tag_name, $tag_args);
-            
-            # Check tag processor return value
-            croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)")
-              if !defined $expand || ref $key_infos ne 'ARRAY';
-            
-            # Check placeholder count
-            croak("Placeholder count in SQL created by tag processor '$tag_name' " .
-                  "must be same as key informations count")
-              unless $self->_placeholder_count($expand) eq @$key_infos;
-            
-            # Add key information
-            push @$all_key_infos, @$key_infos;
-            
-            # Join expand tag to SQL
-            $sql .= $expand;
-        }
-    }
-    
-    # Add semicolon
-    $sql .= ';' unless $sql =~ /;$/;
-    
-    # Query
-    my $query = {sql => $sql, key_infos => $all_key_infos};
-    
-    return $query;
-}
-
-# Get placeholder count
-sub _placeholder_count {
-    my ($self, $expand) = @_;
-    $expand ||= '';
-    
-    my $count = 0;
-    my $pos   = -1;
-    while (($pos = index($expand, '?', $pos + 1)) != -1) {
-        $count++;
-    }
-    return $count;
-}
-
-Object::Simple->build_class;
-
-
-package DBIx::Custom::SQL::Template::TagProcessor;
-use strict;
-use warnings;
-use Carp 'croak';
-
-# Expand tag '?', '=', '<>', '>', '<', '>=', '<=', 'like'
-sub expand_basic_tag {
-    my ($tag_name, $tag_args) = @_;
-    my $original_key = $tag_args->[0];
-    
-    # Key is not exist
-    croak("You must be pass key as argument to tag '{$tag_name }'")
-      if !$original_key;
-    
-    # Expanded tag
-    my $expand = $tag_name eq '?'
-               ? '?'
-               : "$original_key $tag_name ?";
-    
-    # Get table and clumn name
-    my ($table, $column) = get_table_and_column($original_key);
-    
-    # Parameter key infomation
-    my $key_info = {};
-    
-    # Original key
-    $key_info->{original_key} = $original_key;
-    
-    # Table
-    $key_info->{table}  = $table;
-    
-    # Column name
-    $key_info->{column} = $column;
-    
-    # Access keys
-    my $access_keys = [];
-    push @$access_keys, [$original_key];
-    push @$access_keys, [$table, $column] if $table && $column;
-    $key_info->{access_keys} = $access_keys;
-    
-    # Add parameter key information
-    my $key_infos = [];
-    push @$key_infos, $key_info;
-    
-    return ($expand, $key_infos);
-}
-
-# Expand tag 'in'
-sub expand_in_tag {
-    my ($tag_name, $tag_args) = @_;
-    my ($original_key, $placeholder_count) = @$tag_args;
-    
-    # Key must be specified
-    croak("You must be pass key as first argument of tag '{$tag_name }'\n" . 
-          "Usage: {$tag_name \$key \$placeholder_count}")
-      unless $original_key;
-      
-    
-    # Place holder count must be specified
-    croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" . 
-          "Usage: {$tag_name \$key \$placeholder_count}")
-      if !$placeholder_count || $placeholder_count =~ /\D/;
-
-    # Expand tag
-    my $expand = "$original_key $tag_name (";
-    for (my $i = 0; $i < $placeholder_count; $i++) {
-        $expand .= '?, ';
-    }
-    
-    $expand =~ s/, $//;
-    $expand .= ')';
-    
-    # Get table and clumn name
-    my ($table, $column) = get_table_and_column($original_key);
-    
-    # Create parameter key infomations
-    my $key_infos = [];
-    for (my $i = 0; $i < $placeholder_count; $i++) {
-        # Parameter key infomation
-        my $key_info = {};
-        
-        # Original key
-        $key_info->{original_key} = $original_key;
-        
-        # Table
-        $key_info->{table}   = $table;
-        
-        # Column name
-        $key_info->{column}  = $column;
-        
-        # Access keys
-        my $access_keys = [];
-        push @$access_keys, [$original_key, [$i]];
-        push @$access_keys, [$table, $column, [$i]] if $table && $column;
-        $key_info->{access_keys} = $access_keys;
-        
-        # Add parameter key infos
-        push @$key_infos, $key_info;
-    }
-    
-    return ($expand, $key_infos);
-}
-
-# Get table and column
-sub get_table_and_column {
-    my $key = shift;
-    $key ||= '';
-    
-    return ('', $key) unless $key =~ /\./;
-    
-    my ($table, $column) = split /\./, $key;
-    
-    return ($table, $column);
-}
-
-# Expand tag 'insert'
-sub expand_insert_tag {
-    my ($tag_name, $tag_args) = @_;
-    my $original_keys = $tag_args;
-    
-    # Insert key (k1, k2, k3, ..)
-    my $insert_keys = '(';
-    
-    # placeholder (?, ?, ?, ..)
-    my $place_holders = '(';
-    
-    foreach my $original_key (@$original_keys) {
-        # Get table and column
-        my ($table, $column) = get_table_and_column($original_key);
-        
-        # Join insert column
-        $insert_keys   .= "$column, ";
-        
-        # Join place holder
-        $place_holders .= "?, ";
-    }
-    
-    # Delete last ', '
-    $insert_keys =~ s/, $//;
-    
-    # Close 
-    $insert_keys .= ')';
-    $place_holders =~ s/, $//;
-    $place_holders .= ')';
-    
-    # Expand tag
-    my $expand = "$insert_keys values $place_holders";
-    
-    # Create parameter key infomations
-    my $key_infos = [];
-    foreach my $original_key (@$original_keys) {
-        # Get table and clumn name
-        my ($table, $column) = get_table_and_column($original_key);
-        
-        # Parameter key infomation
-        my $key_info = {};
-        
-        # Original key
-        $key_info->{original_key} = $original_key;
-        
-        # Table
-        $key_info->{table}   = $table;
-        
-        # Column name
-        $key_info->{column}  = $column;
-        
-        # Access keys
-        my $access_keys = [];
-        push @$access_keys, ['#insert', $original_key];
-        push @$access_keys, ['#insert', $table, $column] if $table && $column;
-        push @$access_keys, [$original_key];
-        push @$access_keys, [$table, $column] if $table && $column;
-        $key_info->{access_keys} = $access_keys;
-        
-        # Add parameter key infos
-        push @$key_infos, $key_info;
-    }
-    
-    return ($expand, $key_infos);
-}
-
-# Expand tag 'update'
-sub expand_update_tag {
-    my ($tag_name, $tag_args) = @_;
-    my $original_keys = $tag_args;
-    
-    # Expanded tag
-    my $expand = 'set ';
-    
-    # 
-    foreach my $original_key (@$original_keys) {
-        # Get table and clumn name
-        my ($table, $column) = get_table_and_column($original_key);
-
-        # Join key and placeholder
-        $expand .= "$column = ?, ";
-    }
-    
-    # Delete last ', '
-    $expand =~ s/, $//;
-    
-    # Create parameter key infomations
-    my $key_infos = [];
-    foreach my $original_key (@$original_keys) {
-        # Get table and clumn name
-        my ($table, $column) = get_table_and_column($original_key);
-        
-        # Parameter key infomation
-        my $key_info = {};
-        
-        # Original key
-        $key_info->{original_key} = $original_key;
-        
-        # Table
-        $key_info->{table}  = $table;
-        
-        # Column name
-        $key_info->{column} = $column;
-        
-        # Access keys
-        my $access_keys = [];
-        push @$access_keys, ['#update', $original_key];
-        push @$access_keys, ['#update', $table, $column] if $table && $column;
-        push @$access_keys, [$original_key];
-        push @$access_keys, [$table, $column] if $table && $column;
-        $key_info->{access_keys} = $access_keys;
-        
-        # Add parameter key infos
-        push @$key_infos, $key_info;
-    }
-    
-    return ($expand, $key_infos);
-}
-
-1;
-
-=head1 NAME
-
-DBIx::Custom::SQL::Template - Custamizable SQL Template for DBIx::Custom
-
-=head1 VERSION
-
-Version 0.0101
-
-=cut
-
-=head1 SYNOPSIS
-    
-    my $sql_tmpl = DBIx::Custom::SQL::Template->new;
-    
-    my $tmpl   = "select from table {= k1} && {<> k2} || {like k3}";
-    my $param = {k1 => 1, k2 => 2, k3 => 3};
-    
-    my $query = $sql_template->create_query($tmpl);
-    
-    
-    # Using query from DBIx::Custom
-    use DBIx::Custom;
-    my $dbi = DBI->new(
-       data_source => $data_source,
-       user        => $user,
-       password    => $password, 
-       dbi_options => {PrintError => 0, RaiseError => 1}
-    );
-    
-    $query = $dbi->create_query($tmpl); # This is SQL::Template create_query
-    $dbi->query($query, $param);
-
-=head1 CLASS-OBJECT ACCESSORS
-
-Class-Object accessor is used from both object and class
-
-    $class->$accessor # call from class
-    $self->$accessor  # call form object
-
-=head2 tag_processors
-
-    # Set and get
-    $self           = $sql_tmpl->tag_processors($tag_processors);
-    $tag_processors = $sql_tmpl->tag_processors;
-    
-    # Sample
-    $sql_tmpl->tag_processors(
-        '?' => \&expand_question,
-        '=' => \&expand_equel
-    );
-
-You can use add_tag_processor to add tag processor
-
-=head2 tag_start
-
-    # Set and get
-    $self      = $sql_tmpl->tag_start($tag_start);
-    $tag_start = $sql_tmpl->tag_start;
-    
-    # Sample
-    $sql_tmpl->tag_start('{');
-
-Default is '{'
-
-=head2 tag_end
-
-    # Set and get
-    $self    = $sql_tmpl->tag_start($tag_end);
-    $tag_end = $sql_tmpl->tag_start;
-    
-    # Sample
-    $sql_tmpl->tag_start('}');
-
-Default is '}'
-    
-=head2 tag_syntax
-    
-    # Set and get
-    $self       = $sql_tmpl->tag_syntax($tag_syntax);
-    $tag_syntax = $sql_tmpl->tag_syntax;
-    
-    # Sample
-    $sql_tmpl->tag_syntax(
-        "[Tag]            [Expand]\n" .
-        "{? name}         ?\n" .
-        "{= name}         name = ?\n" .
-        "{<> name}        name <> ?\n"
-    );
-
-=head1 METHODS
-
-=head2 create_query
-    
-    # Create SQL form SQL template
-    $query = $sql_tmpl->create_query($tmpl);
-    
-    # Sample
-    $query = $sql_tmpl->create_sql(
-         "select * from table where {= title} && {like author} || {<= price}")
-    
-    # Result
-    $qeury->{sql} : "select * from table where title = ? && author like ? price <= ?;"
-    $query->{key_infos} : [['title'], ['author'], ['price']]
-    
-    # Sample2 (with table name)
-    ($sql, @bind_values) = $sql_tmpl->create_sql(
-            "select * from table where {= table.title} && {like table.author}",
-            {table => {title => 'Perl', author => '%Taro%'}}
-        )
-    
-    # Result2
-    $query->{sql} : "select * from table where table.title = ? && table.title like ?;"
-    $query->{key_infos} :[ [['table.title'],['table', 'title']],
-                           [['table.author'],['table', 'author']] ]
-
-This method create query using by DBIx::Custom.
-query is two infomation
-
-    1.sql       : SQL
-    2.key_infos : Parameter access key information
-
-=head2 add_tag_processor
-
-Add tag processor
-  
-    # Add
-    $self = $sql_tmpl->add_tag_processor($tag_processor);
-    
-    # Sample
-    $sql_tmpl->add_tag_processor(
-        '?' => sub {
-            my ($tag_name, $tag_args) = @_;
-            
-            my $key1 = $tag_args->[0];
-            my $key2 = $tag_args->[1];
-            
-            my $key_infos = [];
-            
-            # Expand tag and create key informations
-            
-            # Return expand tags and key informations
-            return ($expand, $key_infos);
-        }
-    );
-
-Tag processor recieve 2 argument
-
-    1. Tag name            (?, =, <>, or etc)
-    2. Tag arguments       (arg1 and arg2 in {tag_name arg1 arg2})
-
-Tag processor return 2 value
-
-    1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?')
-    2. Key infomations
-    
-You must be return expanded tag and key infomations.
-
-Key information is a little complex. so I will explan this in future.
-
-If you want to know more, Please see DBIx::Custom::SQL::Template source code.
-
-=head2 clone
-
-    # Clone DBIx::Custom::SQL::Template object
-    $clone = $self->clone;
-    
-=head1 Available Tags
-    
-    # Available Tags
-    [tag]            [expand]
-    {? name}         ?
-    {= name}         name = ?
-    {<> name}        name <> ?
-    
-    {< name}         name < ?
-    {> name}         name > ?
-    {>= name}        name >= ?
-    {<= name}        name <= ?
-    
-    {like name}      name like ?
-    {in name}        name in [?, ?, ..]
-    
-    {insert}  (key1, key2, key3) values (?, ?, ?)
-    {update}     set key1 = ?, key2 = ?, key3 = ?
-    
-    # Sample1
-    $query = $sql_tmpl->create_sql(
-        "insert into table {insert key1 key2}"
-    );
-    # Result1
-    $sql : "insert into table (key1, key2) values (?, ?)"
-    
-    
-    # Sample2
-    $query = $sql_tmpl->create_sql(
-        "update table {update key1 key2} where {= key3}"
-    );
-    
-    # Result2
-    $query->{sql} : "update table set key1 = ?, key2 = ? where key3 = ?;"
-    
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github 
-L<http://github.com/yuki-kimoto>
-L<http://github.com/yuki-kimoto/DBIx-Custom-SQL-Template>
-
-Please let know me bag if you find
-Please request me if you want to do something
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-
-=cut
-
-1; # End of DBIx::Custom::SQL::Template

-136

DBIx-Custom-0.0501/lib/DBIx/Custom/SQLite.pm

View

@@ -1,136 +0,0 @@
-package DBIx::Custom::SQLite;
-use base 'DBIx::Custom::Basic';
-
-use warnings;
-use strict;
-use Carp 'croak';
-
-my $class = __PACKAGE__;
-
-$class->add_format(
-    datetime => $class->formats->{SQL99_datetime},
-    date     => $class->formats->{SQL99_date},
-    time     => $class->formats->{SQL99_time},
-);
-
-sub connect {
-    my $self = shift;
-    
-    if (!$self->data_source && (my $database = $self->database)) {
-        $self->data_source("dbi:SQLite:dbname=$database");
-    }
-    
-    return $self->SUPER::connect;
-}
-
-sub connect_memory {
-    my $self = shift;
-    
-    # Data source for memory database
-    $self->data_source('dbi:SQLite:dbname=:memory:');
-    
-    # Already connected
-    croak("Already connected") if $self->connected;
-    
-    # Connect
-    $self->connect;
-    
-    return $self;
-}
-
-sub reconnect_memory {
-    my $self = shift;
-
-    # Data source for memory database
-    $self->data_source('dbi:SQLite:dbname=:memory:');
-    
-    # Reconnect
-    $self->reconnect;
-    
-    return $self;
-}
-
-
-=head1 NAME
-
-DBIx::Custom::SQLite - DBIx::Custom SQLite implementation
-
-=head1 Version
-
-Version 0.0201
-
-=head1 Synopsys
-
-    use DBIx::Custom::SQLite;
-    
-    # New
-    my $dbi = DBIx::Custom::SQLite->new(user => 'taro', $password => 'kliej&@K',
-                                       database => 'sample.db');
-    
-    # Insert 
-    $dbi->insert('books', {title => 'perl', author => 'taro'});
-    
-    # Update 
-    # same as 'update books set (title = 'aaa', author = 'ken') where id = 5;
-    $dbi->update('books', {title => 'aaa', author => 'ken'}, {id => 5});
-    
-    # Delete
-    $dbi->delete('books', {author => 'taro'});
-    
-    # select * from books;
-    $dbi->select('books');
-    
-    # select * from books where ahthor = 'taro'; 
-    $dbi->select('books', {author => 'taro'}); 
-    
-    # select author, title from books where author = 'taro'
-    $dbi->select('books', [qw/author title/], {author => 'taro'});
-    
-    # select author, title from books where author = 'taro' order by id limit 1;
-    $dbi->select('books', [qw/author title/], {author => 'taro'},
-                 'order by id limit 1');
-
-=head1 See DBIx::Custom and DBI::Custom::Basic documentation
-
-This class is L<DBIx::Custom::Basic> subclass.
-and L<DBIx::Custom::Basic> is L<DBIx::Custom> subclass
-
-You can use all methods of L<DBIx::Custom::Basic> and <DBIx::Custom>
-Please see L<DBIx::Custom::Basic> and <DBIx::Custom> documentation
-
-=head1 Object methods
-
-=head2 connect
-
-This override L<DBIx::Custom> connect.
-
-    # Connect to database
-    $dbi->connect;
-
-If database attribute is set, automatically data source is created and connect
-
-=head2 connect_memory
-
-    # Connect memory database
-    $self = $dbi->connect_memory;
-
-=head2 reconnect_memory
-
-    # Reconnect memory database
-    $self = $dbi->reconnect_memory;
-
-=head1 Author
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
-
-=head1 Copyright & lisence
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-15

DBIx-Custom-0.0501/t/00-load.t

View

@@ -1,15 +0,0 @@
-#!perl -T
-
-use Test::More tests => 7;
-
-BEGIN {
-	use_ok( 'DBIx::Custom' );
-	use_ok( 'DBIx::Custom::Basic' );
-	use_ok( 'DBIx::Custom::MySQL' );
-	use_ok( 'DBIx::Custom::Query' );
-	use_ok( 'DBIx::Custom::Result' );
-	use_ok( 'DBIx::Custom::SQL::Template' );
-	use_ok( 'DBIx::Custom::SQLite' );
-}
-
-diag( "Testing DBIx::Custom $DBIx::Custom::VERSION, Perl $], $^X" );

-51

DBIx-Custom-0.0501/t/boilerplate.t

View

@@ -1,51 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-sub not_in_file_ok {
-    my ($filename, %regex) = @_;
-    open( my $fh, '<', $filename )
-        or die "couldn't open $filename for reading: $!";
-
-    my %violated;
-
-    while (my $line = <$fh>) {
-        while (my ($desc, $regex) = each %regex) {
-            if ($line =~ $regex) {
-                push @{$violated{$desc}||=[]}, $.;
-            }
-        }
-    }
-
-    if (%violated) {
-        fail("$filename contains boilerplate text");
-        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
-    } else {
-        pass("$filename contains no boilerplate text");
-    }
-}
-
-sub module_boilerplate_ok {
-    my ($module) = @_;
-    not_in_file_ok($module =>
-        'the great new $MODULENAME'   => qr/ - The great new /,
-        'boilerplate description'     => qr/Quick summary of what the module/,
-        'stub function definition'    => qr/function[12]/,
-    );
-}
-
-
-  not_in_file_ok(README =>
-    "The README is used..."       => qr/The README is used/,
-    "'version information here'"  => qr/to provide version information/,
-  );
-
-  not_in_file_ok(Changes =>
-    "placeholder date/time"       => qr(Date/time)
-  );
-
-  module_boilerplate_ok('lib/DBIx/Custom.pm');
-
-

-67

DBIx-Custom-0.0501/t/dbi-custom-basic-sqlite.t

View

@@ -1,67 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-use utf8;
-use Encode qw/decode encode/;
-
-BEGIN {
-    eval { require DBD::SQLite; 1 }
-        or plan skip_all => 'DBD::SQLite required';
-    eval { DBD::SQLite->VERSION >= 1 }
-        or plan skip_all => 'DBD::SQLite >= 1.00 required';
-
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Constant varialbes for test
-my $CREATE_TABLE = {
-    0 => 'create table table1 (key1 char(255), key2 char(255));',
-    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
-    2 => 'create table table2 (key1 char(255), key3 char(255));'
-};
-
-my $SELECT_TMPL = {
-    0 => 'select * from table1;'
-};
-
-my $DROP_TABLE = {
-    0 => 'drop table table1'
-};
-
-my $NEW_ARGS = {
-    0 => {data_source => 'dbi:SQLite:dbname=:memory:'}
-};
-
-# Variables for test
-my $dbi;
-my $decoded_str;
-my $encoded_str;
-my $array;
-
-use DBIx::Custom::Basic;
-
-test 'Filter';
-$dbi = DBIx::Custom::Basic->new($NEW_ARGS->{0});
-ok($dbi->filters->{encode_utf8}, "$test : exists default_bind_filter");
-ok($dbi->filters->{decode_utf8}, "$test : exists default_fetch_filter");
-
-$dbi->utf8_filter_on;
-is($dbi->bind_filter, $dbi->filters->{encode_utf8}, 'default bind filter');
-is($dbi->fetch_filter, $dbi->filters->{decode_utf8}, 'default fetch filter');
-
-$decoded_str = 'あ';
-$encoded_str = $dbi->bind_filter->($decoded_str);
-is($encoded_str, encode('UTF-8', $decoded_str), "$test : encode utf8");
-is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");
-
-$decoded_str = 'a';
-$encoded_str = $dbi->bind_filter->($decoded_str);
-is($encoded_str, encode('UTF-8', $decoded_str), "$test : upgrade and encode utf8");
-is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");

-36

DBIx-Custom-0.0501/t/dbi-custom-core-mysql-private.t

View

@@ -1,36 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-# user password database
-our ($USER, $PASSWORD, $DATABASE) = connect_info();
-
-plan skip_all => 'private MySQL test' unless $USER;
-
-plan 'no_plan';
-
-use DBIx::Custom;
-use Scalar::Util 'blessed';
-{
-    my $dbi = DBIx::Custom->new(
-        user => $USER,
-        password => $PASSWORD,
-        data_source => "dbi:mysql:dbname=$DATABASE"
-    );
-    $dbi->connect;
-    
-    ok(blessed $dbi->dbh);
-    can_ok($dbi->dbh, qw/prepare/);
-}
-
-sub connect_info {
-    my $file = 'password.tmp';
-    open my $fh, '<', $file
-      or return;
-    
-    my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);
-    
-    close $fh;
-    
-    return ($user, $password, $database);
-}

-716

DBIx-Custom-0.0501/t/dbi-custom-core-sqlite.t

View

@@ -1,716 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-BEGIN {
-    eval { require DBD::SQLite; 1 }
-        or plan skip_all => 'DBD::SQLite required';
-    eval { DBD::SQLite->VERSION >= 1.25 }
-        or plan skip_all => 'DBD::SQLite >= 1.25 required';
-
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Constant varialbes for test
-my $CREATE_TABLE = {
-    0 => 'create table table1 (key1 char(255), key2 char(255));',
-    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
-    2 => 'create table table2 (key1 char(255), key3 char(255));'
-};
-
-my $SELECT_TMPL = {
-    0 => 'select * from table1;'
-};
-
-my $DROP_TABLE = {
-    0 => 'drop table table1'
-};
-
-my $NEW_ARGS = {
-    0 => {data_source => 'dbi:SQLite:dbname=:memory:'}
-};
-
-# Variables for test
-my $dbi;
-my $sth;
-my $tmpl;
-my @tmpls;
-my $select_tmpl;
-my $insert_tmpl;
-my $update_tmpl;
-my $params;
-my $sql;
-my $result;
-my @rows;
-my $rows;
-my $query;
-my @queries;
-my $select_query;
-my $insert_query;
-my $update_query;
-my $ret_val;
-
-
-test 'disconnect';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->connect;
-$dbi->disconnect;
-ok(!$dbi->dbh, $test);
-
-
-test 'connected';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-ok(!$dbi->connected, "$test : not connected");
-$dbi->connect;
-ok($dbi->connected, "$test : connected");
-
-
-test 'preapare';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$sth = $dbi->prepare($CREATE_TABLE->{0});
-ok($sth, "$test : auto connect");
-$sth->execute;
-$sth = $dbi->prepare($DROP_TABLE->{0});
-ok($sth, "$test : basic");
-
-
-test 'do';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$ret_val = $dbi->do($CREATE_TABLE->{0});
-ok(defined $ret_val, "$test : auto connect");
-$ret_val = $dbi->do($DROP_TABLE->{0});
-ok(defined $ret_val, "$test : basic");
-
-
-# Prepare table
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->connect;
-$dbi->do($CREATE_TABLE->{0});
-$sth = $dbi->prepare("insert into table1 (key1, key2) values (?, ?);");
-$sth->execute(1, 2);
-$sth->execute(3, 4);
-
-
-test 'DBIx::Custom::Result test';
-$tmpl = "select key1, key2 from table1";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query);
-
-@rows = ();
-while (my $row = $result->fetch) {
-    push @rows, [@$row];
-}
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch scalar context");
-
-$result = $dbi->execute($query);
-@rows = ();
-while (my @row = $result->fetch) {
-    push @rows, [@row];
-}
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch list context");
-
-$result = $dbi->execute($query);
-@rows = ();
-while (my $row = $result->fetch_hash) {
-    push @rows, {%$row};
-}
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : fetch_hash scalar context");
-
-$result = $dbi->execute($query);
-@rows = ();
-while (my %row = $result->fetch_hash) {
-    push @rows, {%row};
-}
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : fetch hash list context");
-
-$result = $dbi->execute($query);
-$rows = $result->fetch_all;
-is_deeply($rows, [[1, 2], [3, 4]], "$test : fetch_all scalar context");
-
-$result = $dbi->execute($query);
-@rows = $result->fetch_all;
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch_all list context");
-
-$result = $dbi->execute($query);
-@rows = $result->fetch_hash_all;
-is_deeply($rows, [[1, 2], [3, 4]], "$test : fetch_hash_all scalar context");
-
-$result = $dbi->execute($query);
-@rows = $result->fetch_all;
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch_hash_all list context");
-
-
-test 'Insert query return value';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$tmpl = "insert into table1 {insert key1 key2}";
-$query = $dbi->create_query($tmpl);
-$ret_val = $dbi->execute($query, {key1 => 1, key2 => 2});
-ok($ret_val, $test);
-
-
-test 'Direct execute';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$insert_tmpl = "insert into table1 {insert key1 key2}";
-$dbi->execute($insert_tmpl, {key1 => 1, key2 => 2}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        if ($key eq 'key2') {
-            return $value + 1;
-        }
-        return $value;
-    });
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 3}], $test);
-
-
-test 'Filter basic';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-
-$insert_tmpl  = "insert into table1 {insert key1 key2};";
-$insert_query = $dbi->create_query($insert_tmpl);
-$insert_query->bind_filter(sub {
-    my ($value, $key, $table, $column) = @_;
-    if ($key eq 'key1' && $table eq '' && $column eq 'key1') {
-        return $value * 2;
-    }
-    return $value;
-});
-$dbi->execute($insert_query, {key1 => 1, key2 => 2});
-$select_query = $dbi->create_query($SELECT_TMPL->{0});
-$select_query->fetch_filter(sub {
-    my ($value, $key, $type, $sth, $i) = @_;
-    if ($key eq 'key2' && $type =~ /char/ && $sth->can('execute') && $i == 1) {
-        return $value * 3;
-    }
-    return $value;
-});
-$result = $dbi->execute($select_query);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 2, key2 => 6}], "$test : bind_filter fetch_filter");
-
-$dbi->do("delete from table1;");
-$insert_query->no_bind_filters('key1');
-$select_query->no_fetch_filters('key2');
-$dbi->execute($insert_query, {key1 => 1, key2 => 2});
-$result = $dbi->execute($select_query);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : no_fetch_filters no_bind_filters");
-
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$insert_tmpl  = "insert into table1 {insert table1.key1 table1.key2}";
-$insert_query = $dbi->create_query($insert_tmpl);
-$insert_query->bind_filter(sub {
-    my ($value, $key, $table, $column) = @_;
-    if ($key eq 'table1.key1' && $table eq 'table1' && $column eq 'key1') {
-        return $value * 3;
-    }
-    return $value;
-});
-$dbi->execute($insert_query, {table1 => {key1 => 1, key2 => 2}});
-$select_query = $dbi->create_query($SELECT_TMPL->{0});
-$result       = $dbi->execute($select_query);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 2}], "$test : insert with table name");
-
-test 'Filter in';
-$insert_tmpl  = "insert into table1 {insert key1 key2};";
-$insert_query = $dbi->create_query($insert_tmpl);
-$dbi->execute($insert_query, {key1 => 2, key2 => 4});
-$select_tmpl = "select * from table1 where {in table1.key1 2} and {in table1.key2 2}";
-$select_query = $dbi->create_query($select_tmpl);
-$select_query->bind_filter(sub {
-    my ($value, $key, $table, $column) = @_;
-    if ($key eq 'table1.key1' && $table eq 'table1' && $column eq 'key1' || $key eq 'table1.key2') {
-        return $value * 2;
-    }
-    return $value;
-});
-$result = $dbi->execute($select_query, {table1 => {key1 => [1,5], key2 => [2,5]}});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 2, key2 => 4}], "$test : bind_filter");
-
-
-test 'DBIx::Custom::SQL::Template basic tag';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{1});
-$sth = $dbi->prepare("insert into table1 (key1, key2, key3, key4, key5) values (?, ?, ?, ?, ?);");
-$sth->execute(1, 2, 3, 4, 5);
-$sth->execute(6, 7, 8, 9, 10);
-
-$tmpl = "select * from table1 where {= key1} and {<> key2} and {< key3} and {> key4} and {>= key5};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {key1 => 1, key2 => 3, key3 => 4, key4 => 3, key5 => 5});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag1");
-
-$tmpl = "select * from table1 where {= table1.key1} and {<> table1.key2} and {< table1.key3} and {> table1.key4} and {>= table1.key5};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {table1 => {key1 => 1, key2 => 3, key3 => 4, key4 => 3, key5 => 5}});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag1 with table");
-
-$tmpl = "select * from table1 where {= table1.key1} and {<> table1.key2} and {< table1.key3} and {> table1.key4} and {>= table1.key5};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {'table1.key1' => 1, 'table1.key2' => 3, 'table1.key3' => 4, 'table1.key4' => 3, 'table1.key5' => 5});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag1 with table dot");
-
-$tmpl = "select * from table1 where {<= key1} and {like key2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {key1 => 1, key2 => '%2%'});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag2");
-
-$tmpl = "select * from table1 where {<= table1.key1} and {like table1.key2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {table1 => {key1 => 1, key2 => '%2%'}});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag2 with table");
-
-$tmpl = "select * from table1 where {<= table1.key1} and {like table1.key2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {'table1.key1' => 1, 'table1.key2' => '%2%'});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag2 with table dot");
-
-
-test 'DIB::Custom::SQL::Template in tag';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{1});
-$sth = $dbi->prepare("insert into table1 (key1, key2, key3, key4, key5) values (?, ?, ?, ?, ?);");
-$sth->execute(1, 2, 3, 4, 5);
-$sth->execute(6, 7, 8, 9, 10);
-
-$tmpl = "select * from table1 where {in key1 2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {key1 => [9, 1]});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic");
-
-$tmpl = "select * from table1 where {in table1.key1 2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {table1 => {key1 => [9, 1]}});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table");
-
-$tmpl = "select * from table1 where {in table1.key1 2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {'table1.key1' => [9, 1]});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table dot");
-
-
-test 'DBIx::Custom::SQL::Template insert tag';
-$dbi->do("delete from table1");
-$insert_tmpl = 'insert into table1 {insert key1 key2 key3 key4 key5}';
-$dbi->execute($insert_tmpl, {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic");
-
-$dbi->do("delete from table1");
-$dbi->execute($insert_tmpl, {'#insert' => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : #insert");
-
-$dbi->do("delete from table1");
-$insert_tmpl = 'insert into table1 {insert table1.key1 table1.key2 table1.key3 table1.key4 table1.key5}';
-$dbi->execute($insert_tmpl, {table1 => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table name");
-
-$dbi->do("delete from table1");
-$insert_tmpl = 'insert into table1 {insert table1.key1 table1.key2 table1.key3 table1.key4 table1.key5}';
-$dbi->execute($insert_tmpl, {'table1.key1' => 1, 'table1.key2' => 2, 'table1.key3' => 3, 'table1.key4' => 4, 'table1.key5' => 5});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table name dot");
-
-$dbi->do("delete from table1");
-$dbi->execute($insert_tmpl, {'#insert' => {table1 => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : #insert with table name");
-
-$dbi->do("delete from table1");
-$dbi->execute($insert_tmpl, {'#insert' => {'table1.key1' => 1, 'table1.key2' => 2, 'table1.key3' => 3, 'table1.key4' => 4, 'table1.key5' => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : #insert with table name dot");
-
-
-test 'DBIx::Custom::SQL::Template update tag';
-$dbi->do("delete from table1");
-$insert_tmpl = "insert into table1 {insert key1 key2 key3 key4 key5}";
-$dbi->execute($insert_tmpl, {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->execute($insert_tmpl, {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-
-$update_tmpl = 'update table1 {update key1 key2 key3 key4} where {= key5}';
-$dbi->execute($update_tmpl, {key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5});
-
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : basic");
-
-$dbi->execute($update_tmpl, {'#update' => {key1 => 2, key2 => 2, key3 => 2, key4 => 2}, key5 => 5});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 2, key2 => 2, key3 => 2, key4 => 2, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : #update");
-
-$update_tmpl = 'update table1 {update table1.key1 table1.key2 table1.key3 table1.key4} where {= table1.key5}';
-$dbi->execute($update_tmpl, {table1 => {key1 => 3, key2 => 3, key3 => 3, key4 => 3, key5 => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 3, key3 => 3, key4 => 3, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : with table name");
-
-$update_tmpl = 'update table1 {update table1.key1 table1.key2 table1.key3 table1.key4} where {= table1.key5}';
-$dbi->execute($update_tmpl, {'table1.key1' => 4, 'table1.key2' => 4, 'table1.key3' => 4, 'table1.key4' => 4, 'table1.key5' => 5});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 4, key2 => 4, key3 => 4, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : with table name dot");
-
-$dbi->execute($update_tmpl, {'#update' => {table1 => {key1 => 5, key2 => 5, key3 => 5, key4 => 5}}, table1 => {key5 => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 5, key2 => 5, key3 => 5, key4 => 5, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : update tag #update with table name");
-
-$dbi->execute($update_tmpl, {'#update' => {'table1.key1' => 6, 'table1.key2' => 6, 'table1.key3' => 6, 'table1.key4' => 6}, 'table1.key5' => 5});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 6, key2 => 6, key3 => 6, key4 => 6, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : update tag #update with table name dot");
-
-
-test 'run_tansaction';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->run_transaction(sub {
-    $insert_tmpl = 'insert into table1 {insert key1 key2}';
-    $dbi->execute($insert_tmpl, {key1 => 1, key2 => 2});
-    $dbi->execute($insert_tmpl, {key1 => 3, key2 => 4});
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : commit");
-
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->dbh->{RaiseError} = 0;
-eval{
-    $dbi->run_transaction(sub {
-        $insert_tmpl = 'insert into table1 {insert key1 key2}';
-        $dbi->execute($insert_tmpl, {key1 => 1, key2 => 2});
-        die "Fatal Error";
-        $dbi->execute($insert_tmpl, {key1 => 3, key2 => 4});
-    })
-};
-like($@, qr/Fatal Error.*Rollback is success/ms, "$test : Rollback success message");
-ok(!$dbi->dbh->{RaiseError}, "$test : restore RaiseError value");
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [], "$test : rollback");
-
-
-test 'Error case';
-$dbi = DBIx::Custom->new;
-eval{$dbi->run_transaction};
-like($@, qr/Not yet connect to database/, "$test : Yet Connected");
-
-$dbi = DBIx::Custom->new(data_source => 'dbi:SQLit');
-eval{$dbi->connect;};
-ok($@, "$test : connect error");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->connect;
-$dbi->dbh->{AutoCommit} = 0;
-eval{$dbi->run_transaction()};
-like($@, qr/AutoCommit must be true before transaction start/,
-         "$test : run_transaction auto commit is false");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$sql = 'laksjdf';
-eval{$dbi->prepare($sql)};
-like($@, qr/$sql/, "$test : prepare fail");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$sql = 'laksjdf';
-eval{$dbi->do($sql, qw/1 2 3/)};
-like($@, qr/$sql/, "$test : do fail");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-eval{$dbi->create_query("{p }")};
-ok($@, "$test : create_query invalid SQL template");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$query = $dbi->create_query("select * from table1 where {= key1}");
-eval{$dbi->execute($query, {key2 => 1})};
-like($@, qr/Corresponding key is not found in your parameters/, 
-        "$test : execute corresponding key not found");
-
-
-test 'insert';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : basic");
-
-$dbi->do('delete from table1');
-$dbi->insert('table1', {key1 => 1, key2 => 2}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        if ($key eq 'key1') {
-            return $value * 3;
-        }
-        return $value;
-    });
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 2}], "$test : edit_query_callback");
-
-
-test 'insert error';
-eval{$dbi->insert('table1')};
-like($@, qr/Key-value pairs for insert must be specified to 'insert' second argument/, "$test : insert key-value not specifed");
-
-eval{$dbi->insert('table1', {key1 => 1, key2 => 2}, 'aaa')};
-like($@, qr/Query edit callback must be code reference/, "$test : query edit callback not code ref");
-
-
-test 'update';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{1});
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-$dbi->update('table1', {key2 => 11}, {key1 => 1});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 3, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
-                  "$test : basic");
-                  
-$dbi->do("delete from table1");
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-$dbi->update('table1', {key2 => 12}, {key2 => 2, key3 => 3});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 12, key3 => 3, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
-                  "$test : update key same as search key");
-
-$dbi->do("delete from table1");
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-$dbi->update('table1', {key2 => 11}, {key1 => 1}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        if ($key eq 'key2') {
-            return $value * 2;
-        }
-        return $value;
-    });
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 22, key3 => 3, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
-                  "$test : query edit callback");
-
-
-test 'update error';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{1});
-eval{$dbi->update('table1')};
-like($@, qr/Key-value pairs for update must be specified to 'update' second argument/,
-         "$test : update key-value pairs not specified");
-
-eval{$dbi->update('table1', {key2 => 1})};
-like($@, qr/Key-value pairs for where clause must be specified to 'update' third argument/,
-         "$test : where key-value pairs not specified");
-
-eval{$dbi->update('table1', {key2 => 1}, {key2 => 3}, 'aaa')};
-like($@, qr/Query edit callback must be code reference/, 
-         "$test : query edit callback not code reference");
-
-
-test 'update_all';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{1});
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-$dbi->update_all('table1', {key2 => 10}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        return $value * 2;
-    })
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 20, key3 => 3, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 20, key3 => 8, key4 => 9, key5 => 10}],
-                  "$test : query edit callback");
-
-
-test 'delete';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$dbi->delete('table1', {key1 => 1});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : basic");
-
-$dbi->do("delete from table1;");
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$dbi->delete('table1', {key2 => 1}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        return $value * 2;
-    });
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : query edit callback");
-
-$dbi->delete_all('table1');
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$dbi->delete('table1', {key1 => 1, key2 => 2});
-$rows = $dbi->select('table1')->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : delete multi key");
-
-
-test 'delete error';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-eval{$dbi->delete('table1')};
-like($@, qr/Key-value pairs for where clause must be specified to 'delete' second argument/,
-         "$test : where key-value pairs not specified");
-
-eval{$dbi->delete('table1', {key1 => 1}, 'aaa')};
-like($@, qr/Query edit callback must be code reference/, 
-         "$test : query edit callback not code ref");
-
-
-test 'delete_all';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$dbi->delete_all('table1');
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [], "$test : basic");
-
-
-test 'select';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$rows = $dbi->select('table1')->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2},
-                  {key1 => 3, key2 => 4}], "$test : table");
-
-$rows = $dbi->select('table1', ['key1'])->fetch_hash_all;
-is_deeply($rows, [{key1 => 1}, {key1 => 3}], "$test : table and columns and where key");
-
-$rows = $dbi->select('table1', {key1 => 1})->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : table and columns and where key");
-
-$rows = $dbi->select('table1', ['key1'], {key1 => 3})->fetch_hash_all;
-is_deeply($rows, [{key1 => 3}], "$test : table and columns and where key");
-
-$rows = $dbi->select('table1', "order by key1 desc limit 1")->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : append statement");
-
-$rows = $dbi->select('table1', {key1 => 2}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        if ($key eq 'key1') {
-            return $value - 1;
-        }
-        return $value;
-    });
-})->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : query edit call back");
-
-$dbi->do($CREATE_TABLE->{2});
-$dbi->insert('table2', {key1 => 1, key3 => 5});
-$rows = $dbi->select([qw/table1 table2/],
-                     ['table1.key1 as table1_key1', 'table2.key1 as table2_key1', 'key2', 'key3'],
-                     {'table1.key2' => 2},
-                     "where table1.key1 = table2.key1")->fetch_hash_all;
-is_deeply($rows, [{table1_key1 => 1, table2_key1 => 1, key2 => 2, key3 => 5}], "$test : join");
-
-test 'Cache';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-DBIx::Custom->query_cache_max(2);
-$dbi->do($CREATE_TABLE->{0});
-DBIx::Custom->delete_class_attr('_query_caches');
-DBIx::Custom->delete_class_attr('_query_cache_keys');
-$tmpls[0] = "insert into table1 {insert key1 key2}";
-$queries[0] = $dbi->create_query($tmpls[0]);
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{sql}, $queries[0]->sql, "$test : sql first");
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{key_infos}, $queries[0]->key_infos, "$test : key_infos first");
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls], "$test : cache key first");
-
-$tmpls[1] = "select * from table1";
-$queries[1] = $dbi->create_query($tmpls[1]);
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{sql}, $queries[0]->sql, "$test : sql first");
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{key_infos}, $queries[0]->key_infos, "$test : key_infos first");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql second");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{key_infos}, $queries[1]->key_infos, "$test : key_infos second");
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls], "$test : cache key second");
-
-$tmpls[2] = "select key1, key2 from table1";
-$queries[2] = $dbi->create_query($tmpls[2]);
-ok(!exists DBIx::Custom->_query_caches->{$tmpls[0]}, "$test : cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{key_infos}, $queries[1]->key_infos, "$test : key_infos cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{sql}, $queries[2]->sql, "$test : sql cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{key_infos}, $queries[2]->key_infos, "$test : key_infos cache overflow deleted key");
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls[1, 2]], "$test : cache key third");
-
-$queries[1] = $dbi->create_query($tmpls[1]);
-ok(!exists DBIx::Custom->_query_caches->{$tmpls[0]}, "$test : cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{key_infos}, $queries[1]->key_infos, "$test : key_infos cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{sql}, $queries[2]->sql, "$test : sql cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{key_infos}, $queries[2]->key_infos, "$test : key_infos cache overflow deleted key");
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls[1, 2]], "$test : cache key third");
-

-220

DBIx-Custom-0.0501/t/dbi-custom-core.t

View

@@ -1,220 +0,0 @@
-use Test::More 'no_plan';
-use strict;
-use warnings;
-
-use DBIx::Custom;
-use DBIx::Custom::SQL::Template;
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Variables for test
-our $SQL_TMPL = {
-    0 => DBIx::Custom::SQL::Template->new->tag_start(0),
-    1 => DBIx::Custom::SQL::Template->new->tag_start(1),
-    2 => DBIx::Custom::SQL::Template->new->tag_start(2)
-};
-my $dbi;
-
-
-test 'Constructor';
-$dbi = DBIx::Custom->new(
-    user => 'a',
-    database => 'a',
-    password => 'b',
-    data_source => 'c',
-    dbi_options => {d => 1, e => 2},
-    filters => {
-        f => 3,
-    },
-    bind_filter => 'f',
-    fetch_filter => 'g',
-    result_class => 'g',
-    sql_template => $SQL_TMPL->{0},
-);
-is_deeply($dbi,{user => 'a', database => 'a', password => 'b', data_source => 'c', 
-                dbi_options => {d => 1, e => 2}, filters => {f => 3}, bind_filter => 'f',
-                fetch_filter => 'g', result_class => 'g',
-                sql_template => $SQL_TMPL->{0}}, $test);
-isa_ok($dbi, 'DBIx::Custom');
-
-
-test 'Sub class constructor';
-{
-    package DBIx::Custom::T1;
-    use base 'DBIx::Custom';
-    
-    __PACKAGE__
-      ->user('a')
-      ->database('a')
-      ->password('b')
-      ->data_source('c')
-      ->dbi_options({d => 1, e => 2})
-      ->filters(
-          f => 3
-      )
-      ->formats(
-          f => 3
-      )
-      ->bind_filter('f')
-      ->fetch_filter('g')
-      ->result_class('DBIx::Custom::Result')
-      ->sql_template($SQL_TMPL->{0})
-    ;
-}
-$dbi = DBIx::Custom::T1->new(
-    user => 'ao',
-    database => 'ao',
-    password => 'bo',
-    data_source => 'co',
-    dbi_options => {do => 10, eo => 20},
-    filters => {
-        fo => 30,
-    },
-    formats => {
-        fo => 30,
-    },
-    bind_filter => 'fo',
-    fetch_filter => 'go',
-    result_class => 'ho',
-    sql_template => $SQL_TMPL->{0},
-);
-is($dbi->user, 'ao', "$test : user");
-is($dbi->database, 'ao', "$test : database");
-is($dbi->password, 'bo', "$test : passowr");
-is($dbi->data_source, 'co', "$test : data_source");
-is_deeply($dbi->dbi_options, {do => 10, eo => 20}, "$test : dbi_options");
-is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
-is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
-is($dbi->bind_filter, 'fo', "$test : bind_filter");
-is($dbi->fetch_filter, 'go', "$test : fetch_filter");
-is($dbi->result_class, 'ho', "$test : result_class");
-is($dbi->sql_template->tag_start, 0, "$test : sql_template");
-isa_ok($dbi, 'DBIx::Custom::T1');
-
-test 'Sub class constructor default';
-$dbi = DBIx::Custom::T1->new;
-is($dbi->user, 'a', "$test : user");
-is($dbi->database, 'a', "$test : database");
-is($dbi->password, 'b', "$test : password");
-is($dbi->data_source, 'c', "$test : data_source");
-is_deeply($dbi->dbi_options, {d => 1, e => 2}, "$test : dbi_options");
-is_deeply({$dbi->filters}, {f => 3}, "$test : filters");
-is_deeply({$dbi->formats}, {f => 3}, "$test : formats");
-is($dbi->bind_filter, 'f', "$test : bind_filter");
-is($dbi->fetch_filter, 'g', "$test : fetch_filter");
-is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");
-is($dbi->sql_template->tag_start, 0, "$test : sql_template");
-isa_ok($dbi, 'DBIx::Custom::T1');
-
-
-test 'Sub sub class constructor default';
-{
-    package DBIx::Custom::T1_2;
-    use base 'DBIx::Custom::T1';
-}
-$dbi = DBIx::Custom::T1_2->new;
-is($dbi->user, 'a', "$test : user");
-is($dbi->database, 'a', "$test : database");
-is($dbi->password, 'b', "$test : passowrd");
-is($dbi->data_source, 'c', "$test : data_source");
-is_deeply($dbi->dbi_options, {d => 1, e => 2}, "$test : dbi_options");
-is_deeply(scalar $dbi->filters, {f => 3}, "$test : filters");
-is_deeply(scalar $dbi->formats, {f => 3}, "$test : formats");
-is($dbi->bind_filter, 'f', "$test : bind_filter");
-is($dbi->fetch_filter, 'g', "$test : fetch_filter");
-is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");
-is($dbi->sql_template->tag_start, 0, "$test sql_template");
-isa_ok($dbi, 'DBIx::Custom::T1_2');
-
-
-test 'Customized sub class constructor default';
-{
-    package DBIx::Custom::T1_3;
-    use base 'DBIx::Custom::T1';
-    
-    __PACKAGE__
-      ->user('ao')
-      ->database('ao')
-      ->password('bo')
-      ->data_source('co')
-      ->dbi_options({do => 10, eo => 20})
-      ->filters(
-        fo => 30
-      )
-      ->formats(
-        fo => 30
-      )
-      ->bind_filter('fo')
-      ->fetch_filter('go')
-      ->result_class('ho')
-      ->sql_template($SQL_TMPL->{1})
-    ;
-}
-$dbi = DBIx::Custom::T1_3->new;
-is($dbi->user, 'ao', "$test : user");
-is($dbi->database, 'ao', "$test : database");
-is($dbi->password, 'bo', "$test : password");
-is($dbi->data_source, 'co', "$test : data_source");
-is_deeply($dbi->dbi_options, {do => 10, eo => 20}, "$test : dbi_options");
-is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
-is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
-is($dbi->bind_filter, 'fo', "$test : bind_filter");
-is($dbi->fetch_filter, 'go', "$test : fetch_filter");
-is($dbi->result_class, 'ho', "$test : result_class");
-is($dbi->sql_template->tag_start, 1, "$test : sql_template");
-isa_ok($dbi, 'DBIx::Custom::T1_3');
-
-
-test 'Customized sub class constructor';
-$dbi = DBIx::Custom::T1_3->new(
-    user => 'a',
-    database => 'a',
-    password => 'b',
-    data_source => 'c',
-    dbi_options => {d => 1, e => 2},
-    filters => {
-        f => 3,
-    },
-    formats => {
-        f => 3,
-    },
-    bind_filter => 'f',
-    fetch_filter => 'g',
-    result_class => 'h',
-    sql_template => $SQL_TMPL->{2},
-);
-is($dbi->user, 'a', "$test : user");
-is($dbi->database, 'a', "$test : database");
-is($dbi->password, 'b', "$test : password");
-is($dbi->data_source, 'c', "$test : data_source");
-is_deeply($dbi->dbi_options, {d => 1, e => 2}, "$test : dbi_options");
-is_deeply({$dbi->filters}, {f => 3}, "$test : filters");
-is_deeply({$dbi->formats}, {f => 3}, "$test : formats");
-is($dbi->bind_filter, 'f', "$test : bind_filter");
-is($dbi->fetch_filter, 'g', "$test : fetch_filter");
-is($dbi->result_class, 'h', "$test : result_class");
-is($dbi->sql_template->tag_start, 2, "$test : sql_template");
-isa_ok($dbi, 'DBIx::Custom');
-
-
-test 'add_filters';
-$dbi = DBIx::Custom->new;
-$dbi->add_filter(a => sub {1});
-is($dbi->filters->{a}->(), 1, $test);
-
-test 'add_formats';
-$dbi = DBIx::Custom->new;
-$dbi->add_format(a => sub {1});
-is($dbi->formats->{a}->(), 1, $test);
-
-test 'filter_off';
-$dbi = DBIx::Custom->new;
-$dbi->bind_filter('a');
-$dbi->fetch_filter('b');
-$dbi->filter_off;
-ok(!$dbi->bind_filter,  "$test : bind_filter  off");
-ok(!$dbi->fetch_filter, "$test : fetch_filter off");

-47

DBIx-Custom-0.0501/t/dbi-custom-mysql-private.t

View

@@ -1,47 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-# user password database
-our ($USER, $PASSWORD, $DATABASE) = connect_info();
-
-plan skip_all => 'private MySQL test' unless $USER;
-
-plan 'no_plan';
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-
-# Functions for tests
-sub connect_info {
-    my $file = 'password.tmp';
-    open my $fh, '<', $file
-      or return;
-    
-    my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);
-    
-    close $fh;
-    
-    return ($user, $password, $database);
-}
-
-
-# Constat variables for tests
-my $CLASS = 'DBIx::Custom::MySQL';
-
-# Varialbes for tests
-my $dbi;
-
-use DBIx::Custom::MySQL;
-
-test 'connect';
-$dbi = $CLASS->new(user => $USER, password => $PASSWORD,
-                    database => $DATABASE);
-$dbi->connect;
-is(ref $dbi->dbh, 'DBI::db', $test);
-
-

-85

DBIx-Custom-0.0501/t/dbi-custom-mysql-timeformat.t

View

@@ -1,85 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-BEGIN {
-    eval { require Time::Piece; 1 }
-        or plan skip_all => 'Time::Piece required';
-    
-    eval { Time::Piece->VERSION >= 1.15 }
-        or plan skip_all => 'Time::Piece >= 1.15 requred';
-        
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Varialbe for tests
-
-my $format;
-my $data;
-my $timepiece;
-my $dbi;
-
-use DBIx::Custom::MySQL;
-
-
-test 'SQL99 format';
-$dbi = DBIx::Custom::MySQL->new;
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'SQL99_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'SQL99_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'SQL99_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'ISO-8601 format';
-$data   = '2009-01-02T03:04:05';
-$format = $dbi->formats->{'ISO-8601_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'ISO-8601_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'ISO-8601_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'default format';
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-

-37

DBIx-Custom-0.0501/t/dbi-custom-query.t

View

@@ -1,37 +0,0 @@
-use Test::More 'no_plan';
-
-use strict;
-use warnings;
-use DBIx::Custom::Query;
-
-# Function for test name
-my $test;
-sub test{
-    $test = shift;
-}
-
-# Variables for test
-my $query;
-
-test 'Accessors';
-$query = DBIx::Custom::Query->new(
-    sql              => 'a',
-    key_infos        => 'b',
-    bind_filter      => 'c',
-    no_bind_filters  => [qw/d e/],
-    sth              => 'e',
-    fetch_filter     => 'f',
-    no_fetch_filters => [qw/g h/],
-);
-
-is($query->sql, 'a', "$test : sql");
-is($query->key_infos, 'b', "$test : key_infos ");
-is($query->bind_filter, 'c', "$test : bind_filter");
-is_deeply(scalar $query->no_bind_filters, [qw/d e/], "$test : no_bind_filters");
-is_deeply(scalar $query->_no_bind_filters_map, {d => 1, e => 1}, "$test : _no_bind_filters_map");
-is_deeply(scalar $query->no_fetch_filters, [qw/g h/], "$test : no_fetch_filters");
-is($query->sth, 'e', "$test : sth");
-
-$query->no_bind_filters(undef);
-is_deeply(scalar $query->_no_bind_filters_map, {}, "$test _no_bind_filters_map undef value");
-

-257

DBIx-Custom-0.0501/t/dbi-custom-result-sqlite.t

View

@@ -1,257 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-use DBI;
-
-BEGIN {
-    eval { require DBD::SQLite; 1 }
-        or plan skip_all => 'DBD::SQLite required';
-    eval { DBD::SQLite->VERSION >= 1 }
-        or plan skip_all => 'DBD::SQLite >= 1.00 required';
-
-    plan 'no_plan';
-    use_ok('DBIx::Custom::Result');
-}
-
-my $test;
-sub test {
-    $test = shift;
-}
-
-sub query {
-    my ($dbh, $sql) = @_;
-    my $sth = $dbh->prepare($sql);
-    $sth->execute;
-    return DBIx::Custom::Result->new(sth => $sth);
-}
-
-my $dbh;
-my $sql;
-my $sth;
-my @row;
-my $row;
-my @rows;
-my $rows;
-my $result;
-my $fetch_filter;
-my @error;
-my $error;
-
-$dbh = DBI->connect('dbi:SQLite:dbname=:memory:', undef, undef, {PrintError => 0, RaiseError => 1});
-$dbh->do("create table table1 (key1 char(255), key2 char(255));");
-$dbh->do("insert into table1 (key1, key2) values ('1', '2');");
-$dbh->do("insert into table1 (key1, key2) values ('3', '4');");
-
-$sql = "select key1, key2 from table1";
-
-test 'fetch scalar context';
-$result = query($dbh, $sql);
-@rows = ();
-while (my $row = $result->fetch) {
-    push @rows, [@$row];
-}
-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
-
-
-test 'fetch list context';
-$result = query($dbh, $sql);
-@rows = ();
-while (my @row = $result->fetch) {
-    push @rows, [@row];
-}
-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
-
-test 'fetch_hash scalar context';
-$result = query($dbh, $sql);
-@rows = ();
-while (my $row = $result->fetch_hash) {
-    push @rows, {%$row};
-}
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
-
-
-test 'fetch hash list context';
-$result = query($dbh, $sql);
-@rows = ();
-while (my %row = $result->fetch_hash) {
-    push @rows, {%row};
-}
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
-
-
-test 'fetch_first';
-$result = query($dbh, $sql);
-$row = $result->fetch_first;
-is_deeply($row, [1, 2], "$test : row");
-$row = $result->fetch;
-ok(!$row, "$test : finished");
-
-
-test 'fetch_first list context';
-$result = query($dbh, $sql);
-@row = $result->fetch_first;
-is_deeply([@row], [1, 2], "$test : row");
-@row = $result->fetch;
-ok(!@row, "$test : finished");
-
-
-test 'fetch_hash_first';
-$result = query($dbh, $sql);
-$row = $result->fetch_hash_first;
-is_deeply($row, {key1 => 1, key2 => 2}, "$test : row");
-$row = $result->fetch_hash;
-ok(!$row, "$test : finished");
-
-
-test 'fetch_hash_first list context';
-$result = query($dbh, $sql);
-@row = $result->fetch_hash_first;
-is_deeply({@row}, {key1 => 1, key2 => 2}, "$test : row");
-@row = $result->fetch_hash;
-ok(!@row, "$test : finished");
-
-
-test 'fetch_rows';
-$dbh->do("insert into table1 (key1, key2) values ('5', '6');");
-$dbh->do("insert into table1 (key1, key2) values ('7', '8');");
-$dbh->do("insert into table1 (key1, key2) values ('9', '10');");
-$result = query($dbh, $sql);
-$rows = $result->fetch_rows(2);
-is_deeply($rows, [[1, 2],
-                  [3, 4]], "$test : fetch_rows first");
-$rows = $result->fetch_rows(2);
-is_deeply($rows, [[5, 6],
-                  [7, 8]], "$test : fetch_rows secound");
-$rows = $result->fetch_rows(2);
-is_deeply($rows, [[9, 10]], "$test : fetch_rows third");
-$rows = $result->fetch_rows(2);
-ok(!$rows);
-
-
-test 'fetch_rows list context';
-$result = query($dbh, $sql);
-@rows = $result->fetch_rows(2);
-is_deeply([@rows], [[1, 2],
-                  [3, 4]], "$test : fetch_rows first");
-@rows = $result->fetch_rows(2);
-is_deeply([@rows], [[5, 6],
-                  [7, 8]], "$test : fetch_rows secound");
-@rows = $result->fetch_rows(2);
-is_deeply([@rows], [[9, 10]], "$test : fetch_rows third");
-@rows = $result->fetch_rows(2);
-ok(!@rows);
-
-
-test 'fetch_rows error';
-$result = query($dbh, $sql);
-eval {$result->fetch_rows};
-like($@, qr/Row count must be specified/, "$test : Not specified row count");
-
-
-test 'fetch_hash_rows';
-$result = query($dbh, $sql);
-$rows = $result->fetch_hash_rows(2);
-is_deeply($rows, [{key1 => 1, key2 => 2},
-                  {key1 => 3, key2 => 4}], "$test : fetch_rows first");
-$rows = $result->fetch_hash_rows(2);
-is_deeply($rows, [{key1 => 5, key2 => 6},
-                  {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
-$rows = $result->fetch_hash_rows(2);
-is_deeply($rows, [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
-$rows = $result->fetch_hash_rows(2);
-ok(!$rows);
-
-
-test 'fetch_rows list context';
-$result = query($dbh, $sql);
-@rows = $result->fetch_hash_rows(2);
-is_deeply([@rows], [{key1 => 1, key2 => 2},
-                    {key1 => 3, key2 => 4}], "$test : fetch_rows first");
-@rows = $result->fetch_hash_rows(2);
-is_deeply([@rows], [{key1 => 5, key2 => 6},
-                    {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
-@rows = $result->fetch_hash_rows(2);
-is_deeply([@rows], [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
-@rows = $result->fetch_hash_rows(2);
-ok(!@rows);
-$dbh->do("delete from table1 where key1 = 5 or key1 = 7 or key1 = 9");
-
-
-test 'fetch_rows error';
-$result = query($dbh, $sql);
-eval {$result->fetch_hash_rows};
-like($@, qr/Row count must be specified/, "$test : Not specified row count");
-
-
-test 'fetch_all';
-$result = query($dbh, $sql);
-$rows = $result->fetch_all;
-is_deeply($rows, [[1, 2], [3, 4]], $test);
-
-test 'fetch_all list context';
-$result = query($dbh, $sql);
-@rows = $result->fetch_all;
-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
-
-
-test 'fetch_hash_all';
-$result = query($dbh, $sql);
-@rows = $result->fetch_hash_all;
-is_deeply($rows, [[1, 2], [3, 4]], $test);
-
-
-test 'fetch_hash_all list context';
-$result = query($dbh, $sql);
-@rows = $result->fetch_all;
-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
-
-
-test 'fetch filter';
-$fetch_filter = sub {
-    my ($value, $key, $type, $sth, $i) = @_;
-    if ($key eq 'key1' && $value == 1 && $type =~ /char/i && $i == 0 && $sth->{TYPE}->[$i] eq $type) {
-        return $value * 3;
-    }
-    return $value;
-};
-
-$result = query($dbh, $sql);
-$result->fetch_filter($fetch_filter);
-$rows = $result->fetch_all;
-is_deeply($rows, [[3, 2], [3, 4]], "$test array");
-
-$result = query($dbh, $sql);
-$result->fetch_filter($fetch_filter);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash");
-
-$result = query($dbh, $sql);
-$result->no_fetch_filters(['key1']);
-$rows = $result->fetch_all;
-is_deeply($rows, [[1, 2], [3, 4]], "$test array no filter keys");
-
-$result = query($dbh, $sql);
-$result->no_fetch_filters(['key1']);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash no filter keys");
-
-
-test 'finish';
-$result = query($dbh, $sql);
-$result->fetch;
-$result->finish;
-ok(!$result->fetch, $test);
-
-test 'error'; # Cannot real test
-$result = query($dbh, $sql);
-$sth = $result->sth;
-
-@error = $result->error;
-is(scalar @error, 3, "$test list context count");
-is($error[0], $sth->errstr, "$test list context errstr");
-is($error[1], $sth->err, "$test list context err");
-is($error[2], $sth->state, "$test list context state");
-
-$error = $result->error;
-is($error, $sth->errstr, "$test scalar context");
-

-236

DBIx-Custom-0.0501/t/dbi-custom-sql-template.t

View

@@ -1,236 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More 'no_plan';
-
-use DBIx::Custom::SQL::Template;
-
-# Function for test name
-my $test;
-sub test{
-    $test = shift;
-}
-
-# Variable for test
-my $datas;
-my $sql_tmpl;
-my $query;
-my $ret_val;
-my $clone;
-
-test "Various template pattern";
-$datas = [
-    # Basic tests
-    {   name            => 'placeholder basic',
-        tmpl            => "a {?  k1} b {=  k2} {<> k3} {>  k4} {<  k5} {>= k6} {<= k7} {like k8}", ,
-        sql_expected    => "a ? b k2 = ? k3 <> ? k4 > ? k5 < ? k6 >= ? k7 <= ? k8 like ?;",
-        key_infos_expected   => [
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1']]},
-            {original_key => 'k2', table => '', column => 'k2', access_keys => [['k2']]},
-            {original_key => 'k3', table => '', column => 'k3', access_keys => [['k3']]},
-            {original_key => 'k4', table => '', column => 'k4', access_keys => [['k4']]},
-            {original_key => 'k5', table => '', column => 'k5', access_keys => [['k5']]},
-            {original_key => 'k6', table => '', column => 'k6', access_keys => [['k6']]},
-            {original_key => 'k7', table => '', column => 'k7', access_keys => [['k7']]},
-            {original_key => 'k8', table => '', column => 'k8', access_keys => [['k8']]},
-        ],
-    },
-    {
-        name            => 'placeholder in',
-        tmpl            => "{in k1 3};",
-        sql_expected    => "k1 in (?, ?, ?);",
-        key_infos_expected   => [
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [0]]]},
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [1]]]},
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [2]]]},
-        ],
-    },
-    {
-        name            => 'insert',
-        tmpl            => "{insert k1 k2 k3}",
-        sql_expected    => "(k1, k2, k3) values (?, ?, ?);",
-        key_infos_expected   => [
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['#insert', 'k1'], ['k1']]},
-            {original_key => 'k2', table => '', column => 'k2', access_keys => [['#insert', 'k2'], ['k2']]},
-            {original_key => 'k3', table => '', column => 'k3', access_keys => [['#insert', 'k3'], ['k3']]},
-        ],
-    },
-    {
-        name            => 'update',
-        tmpl            => "{update k1 k2 k3}",
-        sql_expected    => "set k1 = ?, k2 = ?, k3 = ?;",
-        key_infos_expected   => [
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['#update', 'k1'], ['k1']]},
-            {original_key => 'k2', table => '', column => 'k2', access_keys => [['#update', 'k2'], ['k2']]},
-            {original_key => 'k3', table => '', column => 'k3', access_keys => [['#update', 'k3'], ['k3']]},
-        ],
-    },
-    
-    # Table name
-    {
-        name            => 'placeholder with table name',
-        tmpl            => "{= a.k1} {= a.k2}",
-        sql_expected    => "a.k1 = ? a.k2 = ?;",
-        key_infos_expected  => [
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1'], ['a', 'k1']]},
-            {original_key => 'a.k2', table => 'a', column => 'k2', access_keys => [['a.k2'], ['a', 'k2']]},
-        ],
-    },
-    {   
-        name            => 'placeholder in with table name',
-        tmpl            => "{in a.k1 2} {in b.k2 2}",
-        sql_expected    => "a.k1 in (?, ?) b.k2 in (?, ?);",
-        key_infos_expected  => [
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [0]], ['a', 'k1', [0]]]},
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [1]], ['a', 'k1', [1]]]},
-            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [0]], ['b', 'k2', [0]]]},
-            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [1]], ['b', 'k2', [1]]]},
-        ],
-    },
-    {
-        name            => 'insert with table name',
-        tmpl            => "{insert a.k1 b.k2}",
-        sql_expected    => "(k1, k2) values (?, ?);",
-        key_infos_expected  => [
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['#insert', 'a.k1'], ['#insert', 'a', 'k1'], ['a.k1'], ['a', 'k1']]},
-            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['#insert', 'b.k2'], ['#insert', 'b', 'k2'], ['b.k2'], ['b', 'k2']]},
-        ],
-    },
-    {
-        name            => 'update with table name',
-        tmpl            => "{update a.k1 b.k2}",
-        sql_expected    => "set k1 = ?, k2 = ?;",
-        key_infos_expected  => [
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['#update', 'a.k1'], ['#update', 'a', 'k1'], ['a.k1'], ['a', 'k1']]},
-            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['#update', 'b.k2'], ['#update', 'b', 'k2'], ['b.k2'], ['b', 'k2']]},
-        ],
-    },
-    {
-        name            => 'not contain tag',
-        tmpl            => "aaa",
-        sql_expected    => "aaa;",
-        key_infos_expected  => [],
-    }
-];
-
-for (my $i = 0; $i < @$datas; $i++) {
-    my $data = $datas->[$i];
-    my $sql_tmpl = DBIx::Custom::SQL::Template->new;
-    my $query = $sql_tmpl->create_query($data->{tmpl});
-    is($query->{sql}, $data->{sql_expected}, "$test : $data->{name} : sql");
-    is_deeply($query->{key_infos}, $data->{key_infos_expected}, "$test : $data->{name} : key_infos");
-}
-
-
-test 'Original tag processor';
-$sql_tmpl = DBIx::Custom::SQL::Template->new;
-
-$ret_val = $sql_tmpl->add_tag_processor(
-    p => sub {
-        my ($tag_name, $args) = @_;
-        
-        my $expand    = "$tag_name ? $args->[0] $args->[1]";
-        my $key_infos = [2];
-        return ($expand, $key_infos);
-    }
-);
-
-$query = $sql_tmpl->create_query("{p a b}");
-is($query->{sql}, "p ? a b;", "$test : add_tag_processor sql");
-is_deeply($query->{key_infos}, [2], "$test : add_tag_processor key_infos");
-isa_ok($ret_val, 'DBIx::Custom::SQL::Template');
-
-
-test "Tag processor error case";
-$sql_tmpl = DBIx::Custom::SQL::Template->new;
-
-
-eval{$sql_tmpl->create_query("{a }")};
-like($@, qr/Tag '{a }' in SQL template is not exist/, "$test : tag_processor not exist");
-
-$sql_tmpl->add_tag_processor({
-    q => 'string'
-});
-
-eval{$sql_tmpl->create_query("{q}", {})};
-like($@, qr/Tag processor 'q' must be code reference/, "$test : tag_processor not code ref");
-
-$sql_tmpl->add_tag_processor({
-   r => sub {} 
-});
-
-eval{$sql_tmpl->create_query("{r}")};
-like($@, qr/\QTag processor 'r' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return noting");
-
-$sql_tmpl->add_tag_processor({
-   s => sub { return ("a", "")} 
-});
-
-eval{$sql_tmpl->create_query("{s}")};
-like($@, qr/\QTag processor 's' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return not array key_infos");
-
-$sql_tmpl->add_tag_processor(
-    t => sub {return ("a", [])}
-);
-
-eval{$sql_tmpl->create_query("{t ???}")};
-like($@, qr/Tag '{t }' arguments cannot contain '?'/, "$test : cannot contain '?' in tag argument");
-
-
-test 'General error case';
-$sql_tmpl = DBIx::Custom::SQL::Template->new;
-$sql_tmpl->add_tag_processor(
-    a => sub {
-        return ("? ? ?", [[],[]]);
-    }
-);
-eval{$sql_tmpl->create_query("{a}")};
-like($@, qr/Placeholder count in SQL created by tag processor 'a' must be same as key informations count/, "$test placeholder count is invalid");
-
-
-test 'Default tag processor Error case';
-eval{$sql_tmpl->create_query("{= }")};
-like($@, qr/You must be pass key as argument to tag '{= }'/, "$test : basic '=' : key not exist");
-
-eval{$sql_tmpl->create_query("{in }")};
-like($@, qr/You must be pass key as first argument of tag '{in }'/, "$test : in : key not exist");
-
-eval{$sql_tmpl->create_query("{in a}")};
-like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
-     "$test : in : key not exist");
-
-eval{$sql_tmpl->create_query("{in a r}")};
-like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
-     "$test : in : key not exist");
-
-
-test 'Clone';
-$sql_tmpl = DBIx::Custom::SQL::Template->new;
-$sql_tmpl
-  ->tag_start('[')
-  ->tag_end(']')
-  ->tag_syntax('syntax')
-  ->tag_processors({a => 1, b => 2});
-
-$clone = $sql_tmpl->clone;
-is($clone->tag_start, $sql_tmpl->tag_start, "$test : tag_start");
-is($clone->tag_end, $sql_tmpl->tag_end, "$test : tag_end");
-is($clone->tag_syntax, $sql_tmpl->tag_syntax, "$test : tag_syntax");
-
-is_deeply( scalar $clone->tag_processors, scalar $sql_tmpl->tag_processors,
-          "$test : tag_processors deep clone");
-
-isnt($clone->tag_processors, $sql_tmpl->tag_processors, 
-     "$test : tag_processors reference not copy");
-
-$sql_tmpl->tag_processors(undef);
-
-$clone = $sql_tmpl->clone;
-is_deeply(scalar $clone->tag_processors, {}, "$test tag_processor undef copy");
-
-
-
-__END__
-
-
-

-85

DBIx-Custom-0.0501/t/dbi-custom-sqlite-timeformat.t

View

@@ -1,85 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-BEGIN {
-    eval { require Time::Piece; 1 }
-        or plan skip_all => 'Time::Piece required';
-    
-    eval { Time::Piece->VERSION >= 1.15 }
-        or plan skip_all => 'Time::Piece >= 1.15 requred';
-        
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Varialbe for tests
-
-my $format;
-my $data;
-my $timepiece;
-my $dbi;
-
-use DBIx::Custom::SQLite;
-
-
-test 'SQL99 format';
-$dbi = DBIx::Custom::SQLite->new;
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'SQL99_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'SQL99_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'SQL99_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'ISO-8601 format';
-$data   = '2009-01-02T03:04:05';
-$format = $dbi->formats->{'ISO-8601_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'ISO-8601_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'ISO-8601_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'default format';
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-

-69

DBIx-Custom-0.0501/t/dbi-custom-sqlite.t

View

@@ -1,69 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-use utf8;
-
-BEGIN {
-    eval { require DBD::SQLite; 1 }
-        or plan skip_all => 'DBD::SQLite required';
-    eval { DBD::SQLite->VERSION >= 1.25 }
-        or plan skip_all => 'DBD::SQLite >= 1.25 required';
-
-    plan 'no_plan';
-    use_ok('DBIx::Custom::SQLite');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Constant varialbes for test
-my $CREATE_TABLE = {
-    0 => 'create table table1 (key1 char(255), key2 char(255));',
-    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
-    2 => 'create table table2 (key1 char(255), key3 char(255));'
-};
-
-
-# Variables for tests
-my $dbi;
-my $ret_val;
-my $rows;
-my $db_file;
-
-test 'connect_memory';
-$dbi = DBIx::Custom::SQLite->new;
-$dbi->connect_memory;
-$ret_val = $dbi->do($CREATE_TABLE->{0});
-ok(defined $ret_val, $test);
-$dbi->utf8_filter_on;
-$dbi->insert('table1', {key1 => 'あ', key2 => 2});
-$rows = $dbi->select('table1', {key1 => 'あ'})->fetch_hash_all;
-is_deeply($rows, [{key1 => 'あ', key2 => 2}], "$test : select rows");
-
-test 'connect_memory error';
-eval{$dbi->connect_memory};
-like($@, qr/Already connected/, "$test : already connected");
-
-test 'reconnect_memory';
-$dbi = DBIx::Custom::SQLite->new;
-$dbi->reconnect_memory;
-$ret_val = $dbi->do($CREATE_TABLE->{0});
-ok(defined $ret_val, "$test : connect first");
-$dbi->reconnect_memory;
-$ret_val = $dbi->do($CREATE_TABLE->{2});
-ok(defined $ret_val, "$test : connect first");
-
-test 'connect';
-$db_file  = 't/test.db';
-unlink $db_file if -f $db_file;
-$dbi = DBIx::Custom::SQLite->new(database => $db_file);
-$dbi->connect;
-ok(-f $db_file, "$test : database file");
-$ret_val = $dbi->do($CREATE_TABLE->{0});
-ok(defined $ret_val, "$test : database");
-$dbi->disconnect;
-unlink $db_file if -f $db_file;
-

-67

DBIx-Custom-0.0501/t/dib-custom-basic-timeformat.t

View

@@ -1,67 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-BEGIN {
-    eval { require Time::Piece; 1 }
-        or plan skip_all => 'Time::Piece required';
-    
-    eval { Time::Piece->VERSION >= 1.15 }
-        or plan skip_all => 'Time::Piece >= 1.15 requred';
-        
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Varialbe for tests
-
-my $format;
-my $data;
-my $timepiece;
-my $dbi;
-
-use DBIx::Custom::Basic;
-
-
-test 'SQL99 format';
-$dbi = DBIx::Custom::Basic->new;
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'SQL99_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'SQL99_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'SQL99_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'ISO-8601 format';
-$data   = '2009-01-02T03:04:05';
-$format = $dbi->formats->{'ISO-8601_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'ISO-8601_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'ISO-8601_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-

-18

DBIx-Custom-0.0501/t/pod-coverage.t

View

@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
-    if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
-    if $@;
-
-all_pod_coverage_ok();

-12

DBIx-Custom-0.0501/t/pod.t

View

@@ -1,12 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod
-my $min_tp = 1.22;
-eval "use Test::Pod $min_tp";
-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
-
-all_pod_files_ok();

-11

DBIx-Custom-Basic/.gitignore

View

@@ -1,11 +0,0 @@
-*.bak
-*.BAK
-Build
-MANIFEST
-META.yml
-Makefile.PL
-_build/*
-blib/*
-*.tar.gz
-cover_db/*
-*.tmp

-24

DBIx-Custom-Basic/Build.PL

View

@@ -1,24 +0,0 @@
-use strict;
-use warnings;
-use Module::Build;
-
-my $builder = Module::Build->new(
-    module_name         => 'DBIx::Custom::Basic',
-    license             => 'perl',
-    dist_author         => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
-    dist_version_from   => 'lib/DBIx/Custom/Basic.pm',
-    build_requires => {
-        'Test::More' => 0,
-    },
-    requires => {
-        'Encode'       => 0,
-        'DBIx::Custom' => 0.0101
-    },
-    recommends => {
-        'Time::Piece' => 1.15
-    },
-    add_to_cleanup      => [ 'DBIx-Custom-Basic-*' ],
-    create_makefile_pl => 'traditional',
-);
-
-$builder->create_build_script();

-8

DBIx-Custom-Basic/Changes

View

@@ -1,8 +0,0 @@
-0.0201
-  delete default_bind_filter
-  delete default_fetch_filter
-  add filter encode_utf8
-  add filter decode_utf8
-  add method utf8_filter_on
-0.0101
-  First release

-15

DBIx-Custom-Basic/MANIFEST.SKIP

View

@@ -1,15 +0,0 @@
-\bRCS\b
-\bCVS\b
-^MANIFEST\.
-^Makefile$
-^Build$
-^Build.bat$
-^_build/
-\.(bak|tdy|old|tmp)$
-~$
-^blib/
-^pm_to_blib
-\.cvsignore
-\.gz$
-^\.git
-^cover_db/

-15

DBIx-Custom-Basic/README

View

@@ -1,15 +0,0 @@
-DBIx-Custom-Basic
-
-DBIx::Custom basic implementation
-
-INSTALLATION
-
-cpan DBIx::Custom::Basic
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2009 Yuki Kimoto
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-119

DBIx-Custom-Basic/lib/DBIx/Custom/Basic.pm

View

@@ -1,119 +0,0 @@
-package DBIx::Custom::Basic;
-use 5.008001;
-use base 'DBIx::Custom';
-use Encode qw/decode encode/;
-
-use warnings;
-use strict;
-
-our $VERSION = '0.0201';
-
-my $class = __PACKAGE__;
-
-$class->add_filter(
-    encode_utf8 => sub {
-        my $value = shift;
-        utf8::upgrade($value) unless Encode::is_utf8($value);
-        return encode('UTF-8', $value);
-    },
-    decode_utf8 => sub { decode('UTF-8', shift) }
-);
-
-$class->add_format(
-    'SQL99_date'        => '%Y-%m-%d',
-    'SQL99_datetime'    => '%Y-%m-%d %H:%M:%S',
-    'SQL99_time'        => '%H:%M:%S',
-    'ISO-8601_date'     => '%Y-%m-%d',
-    'ISO-8601_datetime' => '%Y-%m-%dT%H:%M:%S',
-    'ISO-8601_time'     => '%H:%M:%S',
-);
-
-# Methods
-sub utf8_filter_on {
-    my $self = shift;
-    $self->bind_filter($self->filters->{encode_utf8});
-    $self->fetch_filter($self->filters->{decode_utf8});
-}
-
-1;
-
-=head1 NAME
-
-DBIx::Custom::Basic - DBIx::Custom basic implementation
-
-=head1 Version
-
-Version 0.0201
-
-=head1 See DBIx::Custom documentation
-
-This class is L<DBIx::Custom> subclass.
-
-You can use all methods of L<DBIx::Custom>
-
-Please see L<DBIx::Custom> documentation
-
-=head1 Filters
-
-=head2 encode_utf8
-
-    # Encode to UTF-8 byte stream (utf8::upgrade is done if need)
-    $dbi->filters->{encode_utf8}->($value);
-    
-This filter is generally used as bind filter
-
-    $dbi->bind_filter($dbi->filters->{encode_utf8});
-
-=head2 decode_utf8
-
-    # Decode to perl internal string
-    $dbi->filters->{decode_utf8}->($value);
-    
-This filter is generally used as fetch filter
-
-    $dbi->fetch_filter($dbi->filters->{decode_utf8});
-
-=head2 Formats
-    
-strptime formats is available
-    
-    # format name        format
-    'SQL99_date'         '%Y-%m-%d',
-    'SQL99_datetime'     '%Y-%m-%d %H:%M:%S',
-    'SQL99_time'         '%H:%M:%S',
-    'ISO-8601_date'      '%Y-%m-%d',
-    'ISO-8601_datetime'  '%Y-%m-%dT%H:%M:%S',
-    'ISO-8601_time'      '%H:%M:%S',
-
-You get format as the following
-
-    my $format = $dbi->formats->{$format_name};
-
-=head1 Methods
-
-=head2 utf8_filter_on
-
-    # Encode and decode utf8 filter on
-    $dbi->utf8_filter_on;
-
-This equel to
-
-    $dbi->bind_filter($dbi->filters->{encode_utf8});
-    $dbi->fetch_filter($dbi->filters->{decode_utf8});
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut

-9

DBIx-Custom-Basic/t/00-load.t

View

@@ -1,9 +0,0 @@
-#!perl -T
-
-use Test::More tests => 1;
-
-BEGIN {
-	use_ok( 'DBIx::Custom::Basic' );
-}
-
-diag( "Testing DBIx::Custom::Basic $DBIx::Custom::Basic::VERSION, Perl $], $^X" );

-67

DBIx-Custom-Basic/t/01-sqlite.t

View

@@ -1,67 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-use utf8;
-use Encode qw/decode encode/;
-
-BEGIN {
-    eval { require DBD::SQLite; 1 }
-        or plan skip_all => 'DBD::SQLite required';
-    eval { DBD::SQLite->VERSION >= 1 }
-        or plan skip_all => 'DBD::SQLite >= 1.00 required';
-
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Constant varialbes for test
-my $CREATE_TABLE = {
-    0 => 'create table table1 (key1 char(255), key2 char(255));',
-    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
-    2 => 'create table table2 (key1 char(255), key3 char(255));'
-};
-
-my $SELECT_TMPL = {
-    0 => 'select * from table1;'
-};
-
-my $DROP_TABLE = {
-    0 => 'drop table table1'
-};
-
-my $NEW_ARGS = {
-    0 => {data_source => 'dbi:SQLite:dbname=:memory:'}
-};
-
-# Variables for test
-my $dbi;
-my $decoded_str;
-my $encoded_str;
-my $array;
-
-use DBIx::Custom::Basic;
-
-test 'Filter';
-$dbi = DBIx::Custom::Basic->new($NEW_ARGS->{0});
-ok($dbi->filters->{encode_utf8}, "$test : exists default_bind_filter");
-ok($dbi->filters->{decode_utf8}, "$test : exists default_fetch_filter");
-
-$dbi->utf8_filter_on;
-is($dbi->bind_filter, $dbi->filters->{encode_utf8}, 'default bind filter');
-is($dbi->fetch_filter, $dbi->filters->{decode_utf8}, 'default fetch filter');
-
-$decoded_str = 'あ';
-$encoded_str = $dbi->bind_filter->($decoded_str);
-is($encoded_str, encode('UTF-8', $decoded_str), "$test : encode utf8");
-is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");
-
-$decoded_str = 'a';
-$encoded_str = $dbi->bind_filter->($decoded_str);
-is($encoded_str, encode('UTF-8', $decoded_str), "$test : upgrade and encode utf8");
-is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");

-64

DBIx-Custom-Basic/t/02-time_format.t

View

@@ -1,64 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-BEGIN {
-    eval { require Time::Piece; 1 }
-        or plan skip_all => 'Time::Piece required';
-    
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Varialbe for tests
-
-my $format;
-my $data;
-my $timepiece;
-my $dbi;
-
-use DBIx::Custom::Basic;
-
-
-test 'SQL99 format';
-$dbi = DBIx::Custom::Basic->new;
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'SQL99_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'SQL99_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'SQL99_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'ISO-8601 format';
-$data   = '2009-01-02T03:04:05';
-$format = $dbi->formats->{'ISO-8601_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'ISO-8601_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'ISO-8601_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-

-49

DBIx-Custom-Basic/t/boilerplate.t

View

@@ -1,49 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-sub not_in_file_ok {
-    my ($filename, %regex) = @_;
-    open( my $fh, '<', $filename )
-        or die "couldn't open $filename for reading: $!";
-
-    my %violated;
-
-    while (my $line = <$fh>) {
-        while (my ($desc, $regex) = each %regex) {
-            if ($line =~ $regex) {
-                push @{$violated{$desc}||=[]}, $.;
-            }
-        }
-    }
-
-    if (%violated) {
-        fail("$filename contains boilerplate text");
-        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
-    } else {
-        pass("$filename contains no boilerplate text");
-    }
-}
-
-sub module_boilerplate_ok {
-    my ($module) = @_;
-    not_in_file_ok($module =>
-        'the great new $MODULENAME'   => qr/ - The great new /,
-        'boilerplate description'     => qr/Quick summary of what the module/,
-        'stub function definition'    => qr/function[12]/,
-    );
-}
-
-  not_in_file_ok(README =>
-    "The README is used..."       => qr/The README is used/,
-    "'version information here'"  => qr/to provide version information/,
-  );
-
-  not_in_file_ok(Changes =>
-    "placeholder date/time"       => qr(Date/time)
-  );
-
-  module_boilerplate_ok('lib/DBIx/Custom/Basic.pm');
-

-18

DBIx-Custom-Basic/t/pod-coverage.t

View

@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
-    if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
-    if $@;
-
-all_pod_coverage_ok();

-12

DBIx-Custom-Basic/t/pod.t

View

@@ -1,12 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod
-my $min_tp = 1.22;
-eval "use Test::Pod $min_tp";
-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
-
-all_pod_files_ok();

-11

DBIx-Custom-MySQL/.gitignore

View

@@ -1,11 +0,0 @@
-*.bak
-*.BAK
-Build
-MANIFEST
-META.yml
-Makefile.PL
-_build/*
-blib/*
-*.tar.gz
-cover_db/*
-*.tmp

-21

DBIx-Custom-MySQL/Build.PL

View

@@ -1,21 +0,0 @@
-use strict;
-use warnings;
-use Module::Build;
-
-my $builder = Module::Build->new(
-    module_name         => 'DBIx::Custom::MySQL',
-    license             => 'perl',
-    dist_author         => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
-    dist_version_from   => 'lib/DBIx/Custom/MySQL.pm',
-    build_requires => {
-        'Test::More' => 0,
-    },
-    requires => {
-        'DBIx::Custom::Basic' => 0.0101,
-        'DBD::mysql' => 4.010
-    },
-    add_to_cleanup      => [ 'DBIx-Custom-MySQL-*' ],
-    create_makefile_pl => 'traditional',
-);
-
-$builder->create_build_script();

-4

DBIx-Custom-MySQL/Changes

View

...	...	@@ -1,4 +0,0 @@
1		-0.0102
2		- Update document
3		-0.0101
4		- First release

-15

DBIx-Custom-MySQL/MANIFEST.SKIP

View

@@ -1,15 +0,0 @@
-\bRCS\b
-\bCVS\b
-^MANIFEST\.
-^Makefile$
-^Build$
-^Build.bat$
-^_build/
-\.(bak|tdy|old|tmp)$
-~$
-^blib/
-^pm_to_blib
-\.cvsignore
-\.gz$
-^\.git
-^cover_db/

-15

DBIx-Custom-MySQL/README

View

@@ -1,15 +0,0 @@
-DBIx-Custom-MySQL
-
-DBIx::Custom MySQL implementation
-
-INSTALLATION
-
-cpan DBIx::Custom::MySQL
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2009 Yuki Kimoto
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-9

DBIx-Custom-MySQL/t/00-load.t

View

@@ -1,9 +0,0 @@
-#!perl -T
-
-use Test::More tests => 1;
-
-BEGIN {
-	use_ok( 'DBIx::Custom::MySQL' );
-}
-
-diag( "Testing DBIx::Custom::MySQL $DBIx::Custom::MySQL::VERSION, Perl $], $^X" );

-82

DBIx-Custom-MySQL/t/02-time_format.t

View

@@ -1,82 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-BEGIN {
-    eval { require Time::Piece; 1 }
-        or plan skip_all => 'Time::Piece required';
-    
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Varialbe for tests
-
-my $format;
-my $data;
-my $timepiece;
-my $dbi;
-
-use DBIx::Custom::MySQL;
-
-
-test 'SQL99 format';
-$dbi = DBIx::Custom::MySQL->new;
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'SQL99_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'SQL99_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'SQL99_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'ISO-8601 format';
-$data   = '2009-01-02T03:04:05';
-$format = $dbi->formats->{'ISO-8601_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'ISO-8601_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'ISO-8601_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'default format';
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-

-47

DBIx-Custom-MySQL/t/101-mysql_private.t

View

@@ -1,47 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-# user password database
-our ($USER, $PASSWORD, $DATABASE) = connect_info();
-
-plan skip_all => 'private MySQL test' unless $USER;
-
-plan 'no_plan';
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-
-# Functions for tests
-sub connect_info {
-    my $file = 'password.tmp';
-    open my $fh, '<', $file
-      or return;
-    
-    my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);
-    
-    close $fh;
-    
-    return ($user, $password, $database);
-}
-
-
-# Constat variables for tests
-my $CLASS = 'DBIx::Custom::MySQL';
-
-# Varialbes for tests
-my $dbi;
-
-use DBIx::Custom::MySQL;
-
-test 'connect';
-$dbi = $CLASS->new(user => $USER, password => $PASSWORD,
-                    database => $DATABASE);
-$dbi->connect;
-is(ref $dbi->dbh, 'DBI::db', $test);
-
-

-51

DBIx-Custom-MySQL/t/boilerplate.t

View

@@ -1,51 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-sub not_in_file_ok {
-    my ($filename, %regex) = @_;
-    open( my $fh, '<', $filename )
-        or die "couldn't open $filename for reading: $!";
-
-    my %violated;
-
-    while (my $line = <$fh>) {
-        while (my ($desc, $regex) = each %regex) {
-            if ($line =~ $regex) {
-                push @{$violated{$desc}||=[]}, $.;
-            }
-        }
-    }
-
-    if (%violated) {
-        fail("$filename contains boilerplate text");
-        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
-    } else {
-        pass("$filename contains no boilerplate text");
-    }
-}
-
-sub module_boilerplate_ok {
-    my ($module) = @_;
-    not_in_file_ok($module =>
-        'the great new $MODULENAME'   => qr/ - The great new /,
-        'boilerplate description'     => qr/Quick summary of what the module/,
-        'stub function definition'    => qr/function[12]/,
-    );
-}
-
-
-  not_in_file_ok(README =>
-    "The README is used..."       => qr/The README is used/,
-    "'version information here'"  => qr/to provide version information/,
-  );
-
-  not_in_file_ok(Changes =>
-    "placeholder date/time"       => qr(Date/time)
-  );
-
-  module_boilerplate_ok('lib/DBIx/Custom/MySQL.pm');
-
-

-18

DBIx-Custom-MySQL/t/pod-coverage.t

View

@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
-    if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
-    if $@;
-
-all_pod_coverage_ok();

-12

DBIx-Custom-MySQL/t/pod.t

View

@@ -1,12 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod
-my $min_tp = 1.22;
-eval "use Test::Pod $min_tp";
-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
-
-all_pod_files_ok();

-11

DBIx-Custom-Query/.gitignore

View

@@ -1,11 +0,0 @@
-*.bak
-*.BAK
-Build
-MANIFEST
-META.yml
-Makefile.PL
-_build/*
-blib/*
-*.tar.gz
-cover_db/*
-*.tmp

-20

DBIx-Custom-Query/Build.PL

View

@@ -1,20 +0,0 @@
-use strict;
-use warnings;
-use Module::Build;
-
-my $builder = Module::Build->new(
-    module_name         => 'DBIx::Custom::Query',
-    license             => 'perl',
-    dist_author         => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
-    dist_version_from   => 'lib/DBIx/Custom/Query.pm',
-    build_requires => {
-        'Test::More' => 0,
-    },
-    requires => {
-        'Object::Simple' => 2.0702,
-    },
-    add_to_cleanup      => [ 'DBIx-Custom-Query-*' ],
-    create_makefile_pl => 'traditional',
-);
-
-$builder->create_build_script();

-2

DBIx-Custom-Query/Changes

View

...	...	@@ -1,2 +0,0 @@
1		-0.0101
2		- First release

-15

DBIx-Custom-Query/MANIFEST.SKIP

View

@@ -1,15 +0,0 @@
-\bRCS\b
-\bCVS\b
-^MANIFEST\.
-^Makefile$
-^Build$
-^Build.bat$
-^_build/
-\.(bak|tdy|old|tmp)$
-~$
-^blib/
-^pm_to_blib
-\.cvsignore
-\.gz$
-^\.git
-^cover_db/

-14

DBIx-Custom-Query/README

View

@@ -1,14 +0,0 @@
-DBIx-Custom-Query
-
-Query object for DBIx::Custom
-
-INSTLLATION
-
-cpan DBIx::Custom::Query
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2009 Yuki Kimoto
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.

-103

DBIx-Custom-Query/lib/DBIx/Custom/Query.pm

View

@@ -1,103 +0,0 @@
-package DBIx::Custom::Query;
-use Object::Simple;
-
-our $VERSION = '0.0101';
-
-sub sql             : Attr {}
-sub key_infos       : Attr {}
-sub bind_filter     : Attr {}
-sub fetch_filter     : Attr {}
-sub sth             : Attr {}
-
-sub no_bind_filters      : Attr { type => 'array', trigger => sub {
-    my $self = shift;
-    my $no_bind_filters = $self->no_bind_filters || [];
-    my %no_bind_filters_map = map {$_ => 1} @{$no_bind_filters};
-    $self->_no_bind_filters_map(\%no_bind_filters_map);
-}}
-sub _no_bind_filters_map : Attr {default => sub { {} }}
-
-sub no_fetch_filters     : Attr { type => 'array', default => sub { [] } }
-
-Object::Simple->build_class;
-
-=head1 NAME
-
-DBIx::Custom::Query - Query object for DBIx::Custom
-
-=head1 VERSION
-
-Version 0.0101
-
-=head1 SYNOPSIS
-
-    # Create query
-    my $dbi = DBIx::Custom->new;
-    my $query = $dbi->create_query($template);
-    
-    # Set query attributes
-    $query->bind_filter($dbi->filters->{default_bind_filter});
-    $query->no_bind_filters('title', 'author');
-    
-    $query->fetch_filter($dbi->filters->{default_fetch_filter});
-    $query->no_fetch_filters('title', 'author');
-    
-    # Execute query
-    $dbi->execute($query, $params);
-
-=head1 OBJECT ACCESSORS
-
-=head2 sth
-
-    # Set and get statement handle
-    $self = $query->sth($sql);
-    $sth  = $query->sth;
-
-=head2 sql
-
-    # Set and get SQL
-    $self = $query->sql($sql);
-    $sql  = $query->sql;
-
-=head2 bind_filter
-
-    # Set and get bind filter
-    $self        = $query->bind_filter($bind_filter);
-    $bind_filter = $query->bind_filter;
-
-=head2 no_bind_filters
-
-    # Set and get keys of no filtering
-    $self            = $query->no_bind_filters($no_filters);
-    $no_bind_filters = $query->no_bind_filters;
-
-=head2 fetch_filter
-
-    # Set and get fetch filter
-    $self        = $query->fetch_filter($fetch_filter);
-    $fetch_filter = $query->fetch_filter;
-
-=head2 no_fetch_filters
-
-    # Set and get keys of no filtering
-    $self            = $query->no_fetch_filters($no_filters);
-    $no_fetch_filters = $query->no_fetch_filters;
-
-=head2 key_infos
-
-    # Set and get key informations
-    $self      = $query->key_infos($key_infos);
-    $key_infos = $query->key_infos;
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.

-9

DBIx-Custom-Query/t/00-load.t

View

@@ -1,9 +0,0 @@
-#!perl -T
-
-use Test::More tests => 1;
-
-BEGIN {
-	use_ok( 'DBIx::Custom::Query' );
-}
-
-diag( "Testing DBIx::Custom::Query $DBIx::Custom::Query::VERSION, Perl $], $^X" );

-37

DBIx-Custom-Query/t/01-core.t

View

@@ -1,37 +0,0 @@
-use Test::More 'no_plan';
-
-use strict;
-use warnings;
-use DBIx::Custom::Query;
-
-# Function for test name
-my $test;
-sub test{
-    $test = shift;
-}
-
-# Variables for test
-my $query;
-
-test 'Accessors';
-$query = DBIx::Custom::Query->new(
-    sql              => 'a',
-    key_infos        => 'b',
-    bind_filter      => 'c',
-    no_bind_filters  => [qw/d e/],
-    sth              => 'e',
-    fetch_filter     => 'f',
-    no_fetch_filters => [qw/g h/],
-);
-
-is($query->sql, 'a', "$test : sql");
-is($query->key_infos, 'b', "$test : key_infos ");
-is($query->bind_filter, 'c', "$test : bind_filter");
-is_deeply(scalar $query->no_bind_filters, [qw/d e/], "$test : no_bind_filters");
-is_deeply(scalar $query->_no_bind_filters_map, {d => 1, e => 1}, "$test : _no_bind_filters_map");
-is_deeply(scalar $query->no_fetch_filters, [qw/g h/], "$test : no_fetch_filters");
-is($query->sth, 'e', "$test : sth");
-
-$query->no_bind_filters(undef);
-is_deeply(scalar $query->_no_bind_filters_map, {}, "$test _no_bind_filters_map undef value");
-

-51

DBIx-Custom-Query/t/boilerplate.t

View

@@ -1,51 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-sub not_in_file_ok {
-    my ($filename, %regex) = @_;
-    open( my $fh, '<', $filename )
-        or die "couldn't open $filename for reading: $!";
-
-    my %violated;
-
-    while (my $line = <$fh>) {
-        while (my ($desc, $regex) = each %regex) {
-            if ($line =~ $regex) {
-                push @{$violated{$desc}||=[]}, $.;
-            }
-        }
-    }
-
-    if (%violated) {
-        fail("$filename contains boilerplate text");
-        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
-    } else {
-        pass("$filename contains no boilerplate text");
-    }
-}
-
-sub module_boilerplate_ok {
-    my ($module) = @_;
-    not_in_file_ok($module =>
-        'the great new $MODULENAME'   => qr/ - The great new /,
-        'boilerplate description'     => qr/Quick summary of what the module/,
-        'stub function definition'    => qr/function[12]/,
-    );
-}
-
-
-  not_in_file_ok(README =>
-    "The README is used..."       => qr/The README is used/,
-    "'version information here'"  => qr/to provide version information/,
-  );
-
-  not_in_file_ok(Changes =>
-    "placeholder date/time"       => qr(Date/time)
-  );
-
-  module_boilerplate_ok('lib/DBIx/Custom/Query.pm');
-
-

-18

DBIx-Custom-Query/t/pod-coverage.t

View

@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
-    if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
-    if $@;
-
-all_pod_coverage_ok();

-12

DBIx-Custom-Query/t/pod.t

View

@@ -1,12 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod
-my $min_tp = 1.22;
-eval "use Test::Pod $min_tp";
-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
-
-all_pod_files_ok();

-10

DBIx-Custom-Result/.gitignore

View

@@ -1,10 +0,0 @@
-*.bak
-*.BAK
-Build
-MANIFEST
-META.yml
-Makefile.PL
-_build/*
-blib/*
-*.tar.gz
-cover_db/*

-21

DBIx-Custom-Result/Build.PL

View

@@ -1,21 +0,0 @@
-use strict;
-use warnings;
-use Module::Build;
-
-my $builder = Module::Build->new(
-    module_name         => 'DBIx::Custom::Result',
-    license             => 'perl',
-    dist_author         => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
-    dist_version_from   => 'lib/DBIx/Custom/Result.pm',
-    build_requires => {
-        'Test::More'  => 0,
-    },
-    requires => {
-        'Object::Simple' => 2.0702,
-        'DBI'            => 1.605,
-    },
-    add_to_cleanup      => [ 'DBIx-Custom-Result-*' ],
-    create_makefile_pl => 'traditional',
-);
-
-$builder->create_build_script();

-10

DBIx-Custom-Result/Changes

View

@@ -1,10 +0,0 @@
-0.0301
-  rename fetch_all_hash to fetch_hash_all (not backword compatible)
-  rename fetch_rows_hash to fetch_hash_rows (not backword compatible)
-  rename fetch_first_hash to fetch_hash_first (not backword compatible)
-0.0202
-  add build requires 'DBI'
-0.0201
-  Exchange filter argument 'key', 'value' (not backword compatible)
-0.0101
-  First release

-15

DBIx-Custom-Result/MANIFEST.SKIP

View

@@ -1,15 +0,0 @@
-\bRCS\b
-\bCVS\b
-^MANIFEST\.
-^Makefile$
-^Build$
-^Build.bat$
-^_build/
-\.(bak|tdy|old|tmp)$
-~$
-^blib/
-^pm_to_blib
-\.cvsignore
-\.gz$
-^\.git
-^cover_db/

-15

DBIx-Custom-Result/README

View

@@ -1,15 +0,0 @@
-DBIx-Custom-Result
-
-Resultset for DBIx::Custom
-
-INSTALLATION
-
-cpan DBIx::Custom::Result
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2009 Yuki Kimoto
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-386

DBIx-Custom-Result/lib/DBIx/Custom/Result.pm

View

@@ -1,386 +0,0 @@
-package DBIx::Custom::Result;
-use Object::Simple;
-use strict;
-use warnings;
-use Carp 'croak';
-
-our $VERSION = '0.0301';
-
-# Attributes
-sub sth              : Attr {}
-sub fetch_filter     : Attr {}
-sub no_fetch_filters      : Attr { type => 'array', trigger => sub {
-    my $self = shift;
-    my $no_fetch_filters = $self->no_fetch_filters || [];
-    my %no_fetch_filters_map = map {$_ => 1} @{$no_fetch_filters};
-    $self->_no_fetch_filters_map(\%no_fetch_filters_map);
-}}
-sub _no_fetch_filters_map : Attr {default => sub { {} }}
-
-# Fetch (array)
-sub fetch {
-    my ($self, $type) = @_;
-    my $sth = $self->sth;
-    my $fetch_filter = $self->fetch_filter;
-    
-    # Fetch
-    my $row = $sth->fetchrow_arrayref;
-    
-    # Cannot fetch
-    return unless $row;
-    
-    # Filter
-    if ($fetch_filter) {
-        my $keys  = $sth->{NAME_lc};
-        my $types = $sth->{TYPE};
-        for (my $i = 0; $i < @$keys; $i++) {
-            next if $self->_no_fetch_filters_map->{$keys->[$i]};
-            $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $types->[$i],
-                                        $sth, $i);
-        }
-    }
-    return wantarray ? @$row : $row;
-}
-
-# Fetch (hash)
-sub fetch_hash {
-    my $self = shift;
-    my $sth = $self->sth;
-    my $fetch_filter = $self->fetch_filter;
-    
-    # Fetch
-    my $row = $sth->fetchrow_arrayref;
-    
-    # Cannot fetch
-    return unless $row;
-    
-    # Keys
-    my $keys  = $sth->{NAME_lc};
-    
-    # Filter
-    my $row_hash = {};
-    if ($fetch_filter) {
-        my $types = $sth->{TYPE};
-        for (my $i = 0; $i < @$keys; $i++) {
-            if ($self->_no_fetch_filters_map->{$keys->[$i]}) {
-                $row_hash->{$keys->[$i]} = $row->[$i];
-            }
-            else {
-                $row_hash->{$keys->[$i]}
-                  = $fetch_filter->($row->[$i], $keys->[$i],
-                                    $types->[$i], $sth, $i);
-            }
-        }
-    }
-    
-    # No filter
-    else {
-        for (my $i = 0; $i < @$keys; $i++) {
-            $row_hash->{$keys->[$i]} = $row->[$i];
-        }
-    }
-    return wantarray ? %$row_hash : $row_hash;
-}
-
-# Fetch only first (array)
-sub fetch_first {
-    my $self = shift;
-    
-    # Fetch
-    my $row = $self->fetch;
-    
-    # Not exist
-    return unless $row;
-    
-    # Finish statement handle
-    $self->finish;
-    
-    return wantarray ? @$row : $row;
-}
-
-# Fetch only first (hash)
-sub fetch_hash_first {
-    my $self = shift;
-    
-    # Fetch hash
-    my $row = $self->fetch_hash;
-    
-    # Not exist
-    return unless $row;
-    
-    # Finish statement handle
-    $self->finish;
-    
-    return wantarray ? %$row : $row;
-}
-
-# Fetch multi rows (array)
-sub fetch_rows {
-    my ($self, $count) = @_;
-    
-    # Not specified Row count
-    croak("Row count must be specified")
-      unless $count;
-    
-    # Fetch multi rows
-    my $rows = [];
-    for (my $i = 0; $i < $count; $i++) {
-        my @row = $self->fetch;
-        
-        last unless @row;
-        
-        push @$rows, \@row;
-    }
-    
-    return unless @$rows;
-    return wantarray ? @$rows : $rows;
-}
-
-# Fetch multi rows (hash)
-sub fetch_hash_rows {
-    my ($self, $count) = @_;
-    
-    # Not specified Row count
-    croak("Row count must be specified")
-      unless $count;
-    
-    # Fetch multi rows
-    my $rows = [];
-    for (my $i = 0; $i < $count; $i++) {
-        my %row = $self->fetch_hash;
-        
-        last unless %row;
-        
-        push @$rows, \%row;
-    }
-    
-    return unless @$rows;
-    return wantarray ? @$rows : $rows;
-}
-
-
-# Fetch all (array)
-sub fetch_all {
-    my $self = shift;
-    
-    my $rows = [];
-    while(my @row = $self->fetch) {
-        push @$rows, [@row];
-    }
-    return wantarray ? @$rows : $rows;
-}
-
-# Fetch all (hash)
-sub fetch_hash_all {
-    my $self = shift;
-    
-    my $rows = [];
-    while(my %row = $self->fetch_hash) {
-        push @$rows, {%row};
-    }
-    return wantarray ? @$rows : $rows;
-}
-
-# Finish
-sub finish { shift->sth->finish }
-
-# Error
-sub error { 
-    my $self = shift;
-    my $sth  = $self->sth;
-    return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr;
-}
-
-Object::Simple->build_class;
-
-=head1 NAME
-
-DBIx::Custom::Result - Resultset for DBIx::Custom
-
-=head1 VERSION
-
-Version 0.0301
-
-=head1 SYNOPSIS
-
-    # $result is DBIx::Custom::Result object
-    my $dbi = DBIx::Custom->new;
-    my $result = $dbi->query($sql_template, $param);
-    
-    while (my ($val1, $val2) = $result->fetch) {
-        # do something
-    }
-
-=head1 OBJECT ACCESSORS
-
-=head2 sth
-
-    # Set and Get statement handle
-    $self = $result->sth($sth);
-    $sth  = $reuslt->sth
-
-Statement handle is automatically set by DBIx::Custom.
-so you do not set statement handle.
-
-If you need statement handle, you can get statement handle by using this method.
-
-=head2 fetch_filter
-
-    # Set and Get fetch filter
-    $self         = $result->fetch_filter($sth);
-    $fetch_filter = $result->fech_filter;
-
-Statement handle is automatically set by DBIx::Custom.
-If you want to set your fetch filter, you set it.
-
-=head2 no_fetch_filters
-
-    # Set and Get no filter keys when fetching
-    $self             = $result->no_fetch_filters($no_fetch_filters);
-    $no_fetch_filters = $result->no_fetch_filters;
-
-=head1 METHODS
-
-=head2 fetch
-
-    # Fetch row as array reference (Scalar context)
-    $row = $result->fetch;
-    
-    # Fetch row as array (List context)
-    @row = $result->fecth
-
-    # Sample
-    while (my $row = $result->fetch) {
-        # do something
-        my $val1 = $row->[0];
-        my $val2 = $row->[1];
-    }
-
-fetch method is fetch resultset and get row as array or array reference.
-
-=head2 fetch_hash
-
-    # Fetch row as hash reference (Scalar context)
-    $row = $result->fetch_hash;
-    
-    # Fetch row as hash (List context)
-    %row = $result->fecth_hash
-
-    # Sample
-    while (my $row = $result->fetch_hash) {
-        # do something
-        my $val1 = $row->{key1};
-        my $val2 = $row->{key2};
-    }
-
-fetch_hash method is fetch resultset and get row as hash or hash reference.
-
-=head2 fetch_first
-
-    # Fetch only first (Scalar context)
-    $row = $result->fetch_first;
-    
-    # Fetch only first (List context)
-    @row = $result->fetch_first;
-    
-This method fetch only first and finish statement handle
-
-=head2 fetch_hash_first
-    
-    # Fetch only first as hash (Scalar context)
-    $row = $result->fetch_hash_first;
-    
-    # Fetch only first as hash (Scalar context)
-    @row = $result->fetch_hash_first;
-    
-This method fetch only first and finish statement handle
-
-=head2 fetch_rows
-
-    # Fetch multi rows (Scalar context)
-    $rows = $result->fetch_rows($row_count);
-    
-    # Fetch multi rows (List context)
-    @rows = $result->fetch_rows($row_count);
-    
-    # Sapmle 
-    $rows = $result->fetch_rows(10);
-
-=head2 fetch_hash_rows
-
-    # Fetch multi rows as hash (Scalar context)
-    $rows = $result->fetch_hash_rows($row_count);
-    
-    # Fetch multi rows as hash (List context)
-    @rows = $result->fetch_hash_rows($row_count);
-    
-    # Sapmle 
-    $rows = $result->fetch_hash_rows(10);
-
-=head2 fetch_all
-
-    # Fetch all row as array ref of array ref (Scalar context)
-    $rows = $result->fetch_all;
-    
-    # Fetch all row as array of array ref (List context)
-    @rows = $result->fecth_all;
-
-    # Sample
-    my $rows = $result->fetch_all;
-    my $val0_0 = $rows->[0][0];
-    my $val1_1 = $rows->[1][1];
-
-fetch_all method is fetch resultset and get all rows as array or array reference.
-
-=head2 fetch_hash_all
-
-    # Fetch all row as array ref of hash ref (Scalar context)
-    $rows = $result->fetch_hash_all;
-    
-    # Fetch all row as array of hash ref (List context)
-    @rows = $result->fecth_all_hash;
-
-    # Sample
-    my $rows = $result->fetch_hash_all;
-    my $val0_key1 = $rows->[0]{key1};
-    my $val1_key2 = $rows->[1]{key2};
-
-=head2 error
-
-    # Get error infomation
-    $error_messege = $result->error;
-    ($error_message, $error_number, $error_state) = $result->error;
-
-You can get get information. This is crenspond to the following.
-
-    $error_message : $result->sth->errstr
-    $error_number  : $result->sth->err
-    $error_state   : $result->sth->state
-
-=head2 finish
-
-    # Finish statement handle
-    $result->finish
-    
-    # Sample
-    my $row = $reuslt->fetch; # fetch only one row
-    $result->finish
-
-You can finish statement handle.This is equel to
-
-    $result->sth->finish;
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut

-9

DBIx-Custom-Result/t/00-load.t

View

@@ -1,9 +0,0 @@
-#!perl -T
-
-use Test::More tests => 1;
-
-BEGIN {
-	use_ok( 'DBIx::Custom::Result' );
-}
-
-diag( "Testing DBIx::Custom::Result $DBIx::Custom::Result::VERSION, Perl $], $^X" );

-257

DBIx-Custom-Result/t/01-sqlite.t

View

@@ -1,257 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-use DBI;
-
-BEGIN {
-    eval { require DBD::SQLite; 1 }
-        or plan skip_all => 'DBD::SQLite required';
-    eval { DBD::SQLite->VERSION >= 1 }
-        or plan skip_all => 'DBD::SQLite >= 1.00 required';
-
-    plan 'no_plan';
-    use_ok('DBIx::Custom::Result');
-}
-
-my $test;
-sub test {
-    $test = shift;
-}
-
-sub query {
-    my ($dbh, $sql) = @_;
-    my $sth = $dbh->prepare($sql);
-    $sth->execute;
-    return DBIx::Custom::Result->new(sth => $sth);
-}
-
-my $dbh;
-my $sql;
-my $sth;
-my @row;
-my $row;
-my @rows;
-my $rows;
-my $result;
-my $fetch_filter;
-my @error;
-my $error;
-
-$dbh = DBI->connect('dbi:SQLite:dbname=:memory:', undef, undef, {PrintError => 0, RaiseError => 1});
-$dbh->do("create table table1 (key1 char(255), key2 char(255));");
-$dbh->do("insert into table1 (key1, key2) values ('1', '2');");
-$dbh->do("insert into table1 (key1, key2) values ('3', '4');");
-
-$sql = "select key1, key2 from table1";
-
-test 'fetch scalar context';
-$result = query($dbh, $sql);
-@rows = ();
-while (my $row = $result->fetch) {
-    push @rows, [@$row];
-}
-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
-
-
-test 'fetch list context';
-$result = query($dbh, $sql);
-@rows = ();
-while (my @row = $result->fetch) {
-    push @rows, [@row];
-}
-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
-
-test 'fetch_hash scalar context';
-$result = query($dbh, $sql);
-@rows = ();
-while (my $row = $result->fetch_hash) {
-    push @rows, {%$row};
-}
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
-
-
-test 'fetch hash list context';
-$result = query($dbh, $sql);
-@rows = ();
-while (my %row = $result->fetch_hash) {
-    push @rows, {%row};
-}
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
-
-
-test 'fetch_first';
-$result = query($dbh, $sql);
-$row = $result->fetch_first;
-is_deeply($row, [1, 2], "$test : row");
-$row = $result->fetch;
-ok(!$row, "$test : finished");
-
-
-test 'fetch_first list context';
-$result = query($dbh, $sql);
-@row = $result->fetch_first;
-is_deeply([@row], [1, 2], "$test : row");
-@row = $result->fetch;
-ok(!@row, "$test : finished");
-
-
-test 'fetch_hash_first';
-$result = query($dbh, $sql);
-$row = $result->fetch_hash_first;
-is_deeply($row, {key1 => 1, key2 => 2}, "$test : row");
-$row = $result->fetch_hash;
-ok(!$row, "$test : finished");
-
-
-test 'fetch_hash_first list context';
-$result = query($dbh, $sql);
-@row = $result->fetch_hash_first;
-is_deeply({@row}, {key1 => 1, key2 => 2}, "$test : row");
-@row = $result->fetch_hash;
-ok(!@row, "$test : finished");
-
-
-test 'fetch_rows';
-$dbh->do("insert into table1 (key1, key2) values ('5', '6');");
-$dbh->do("insert into table1 (key1, key2) values ('7', '8');");
-$dbh->do("insert into table1 (key1, key2) values ('9', '10');");
-$result = query($dbh, $sql);
-$rows = $result->fetch_rows(2);
-is_deeply($rows, [[1, 2],
-                  [3, 4]], "$test : fetch_rows first");
-$rows = $result->fetch_rows(2);
-is_deeply($rows, [[5, 6],
-                  [7, 8]], "$test : fetch_rows secound");
-$rows = $result->fetch_rows(2);
-is_deeply($rows, [[9, 10]], "$test : fetch_rows third");
-$rows = $result->fetch_rows(2);
-ok(!$rows);
-
-
-test 'fetch_rows list context';
-$result = query($dbh, $sql);
-@rows = $result->fetch_rows(2);
-is_deeply([@rows], [[1, 2],
-                  [3, 4]], "$test : fetch_rows first");
-@rows = $result->fetch_rows(2);
-is_deeply([@rows], [[5, 6],
-                  [7, 8]], "$test : fetch_rows secound");
-@rows = $result->fetch_rows(2);
-is_deeply([@rows], [[9, 10]], "$test : fetch_rows third");
-@rows = $result->fetch_rows(2);
-ok(!@rows);
-
-
-test 'fetch_rows error';
-$result = query($dbh, $sql);
-eval {$result->fetch_rows};
-like($@, qr/Row count must be specified/, "$test : Not specified row count");
-
-
-test 'fetch_hash_rows';
-$result = query($dbh, $sql);
-$rows = $result->fetch_hash_rows(2);
-is_deeply($rows, [{key1 => 1, key2 => 2},
-                  {key1 => 3, key2 => 4}], "$test : fetch_rows first");
-$rows = $result->fetch_hash_rows(2);
-is_deeply($rows, [{key1 => 5, key2 => 6},
-                  {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
-$rows = $result->fetch_hash_rows(2);
-is_deeply($rows, [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
-$rows = $result->fetch_hash_rows(2);
-ok(!$rows);
-
-
-test 'fetch_rows list context';
-$result = query($dbh, $sql);
-@rows = $result->fetch_hash_rows(2);
-is_deeply([@rows], [{key1 => 1, key2 => 2},
-                    {key1 => 3, key2 => 4}], "$test : fetch_rows first");
-@rows = $result->fetch_hash_rows(2);
-is_deeply([@rows], [{key1 => 5, key2 => 6},
-                    {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
-@rows = $result->fetch_hash_rows(2);
-is_deeply([@rows], [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
-@rows = $result->fetch_hash_rows(2);
-ok(!@rows);
-$dbh->do("delete from table1 where key1 = 5 or key1 = 7 or key1 = 9");
-
-
-test 'fetch_rows error';
-$result = query($dbh, $sql);
-eval {$result->fetch_hash_rows};
-like($@, qr/Row count must be specified/, "$test : Not specified row count");
-
-
-test 'fetch_all';
-$result = query($dbh, $sql);
-$rows = $result->fetch_all;
-is_deeply($rows, [[1, 2], [3, 4]], $test);
-
-test 'fetch_all list context';
-$result = query($dbh, $sql);
-@rows = $result->fetch_all;
-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
-
-
-test 'fetch_hash_all';
-$result = query($dbh, $sql);
-@rows = $result->fetch_hash_all;
-is_deeply($rows, [[1, 2], [3, 4]], $test);
-
-
-test 'fetch_hash_all list context';
-$result = query($dbh, $sql);
-@rows = $result->fetch_all;
-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
-
-
-test 'fetch filter';
-$fetch_filter = sub {
-    my ($value, $key, $type, $sth, $i) = @_;
-    if ($key eq 'key1' && $value == 1 && $type =~ /char/i && $i == 0 && $sth->{TYPE}->[$i] eq $type) {
-        return $value * 3;
-    }
-    return $value;
-};
-
-$result = query($dbh, $sql);
-$result->fetch_filter($fetch_filter);
-$rows = $result->fetch_all;
-is_deeply($rows, [[3, 2], [3, 4]], "$test array");
-
-$result = query($dbh, $sql);
-$result->fetch_filter($fetch_filter);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash");
-
-$result = query($dbh, $sql);
-$result->no_fetch_filters(['key1']);
-$rows = $result->fetch_all;
-is_deeply($rows, [[1, 2], [3, 4]], "$test array no filter keys");
-
-$result = query($dbh, $sql);
-$result->no_fetch_filters(['key1']);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash no filter keys");
-
-
-test 'finish';
-$result = query($dbh, $sql);
-$result->fetch;
-$result->finish;
-ok(!$result->fetch, $test);
-
-test 'error'; # Cannot real test
-$result = query($dbh, $sql);
-$sth = $result->sth;
-
-@error = $result->error;
-is(scalar @error, 3, "$test list context count");
-is($error[0], $sth->errstr, "$test list context errstr");
-is($error[1], $sth->err, "$test list context err");
-is($error[2], $sth->state, "$test list context state");
-
-$error = $result->error;
-is($error, $sth->errstr, "$test scalar context");
-

-50

DBIx-Custom-Result/t/boilerplate.t

View

@@ -1,50 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-sub not_in_file_ok {
-    my ($filename, %regex) = @_;
-    open( my $fh, '<', $filename )
-        or die "couldn't open $filename for reading: $!";
-
-    my %violated;
-
-    while (my $line = <$fh>) {
-        while (my ($desc, $regex) = each %regex) {
-            if ($line =~ $regex) {
-                push @{$violated{$desc}||=[]}, $.;
-            }
-        }
-    }
-
-    if (%violated) {
-        fail("$filename contains boilerplate text");
-        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
-    } else {
-        pass("$filename contains no boilerplate text");
-    }
-}
-
-sub module_boilerplate_ok {
-    my ($module) = @_;
-    not_in_file_ok($module =>
-        'the great new $MODULENAME'   => qr/ - The great new /,
-        'boilerplate description'     => qr/Quick summary of what the module/,
-        'stub function definition'    => qr/function[12]/,
-    );
-}
-
-  not_in_file_ok(README =>
-    "The README is used..."       => qr/The README is used/,
-    "'version information here'"  => qr/to provide version information/,
-  );
-
-  not_in_file_ok(Changes =>
-    "placeholder date/time"       => qr(Date/time)
-  );
-
-  module_boilerplate_ok('lib/DBIx/Custom/Result.pm');
-
-

-18

DBIx-Custom-Result/t/pod-coverage.t

View

@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
-    if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
-    if $@;
-
-all_pod_coverage_ok();

-12

DBIx-Custom-Result/t/pod.t

View

@@ -1,12 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod
-my $min_tp = 1.22;
-eval "use Test::Pod $min_tp";
-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
-
-all_pod_files_ok();

-10

DBIx-Custom-SQL-Template/.gitignore

View

@@ -1,10 +0,0 @@
-*.bak
-*.BAK
-Build
-MANIFEST
-META.yml
-Makefile.PL
-_build/*
-blib/*
-*.tar.gz
-cover_db/*

-20

DBIx-Custom-SQL-Template/Build.PL

View

@@ -1,20 +0,0 @@
-use strict;
-use warnings;
-use Module::Build;
-
-my $builder = Module::Build->new(
-    module_name         => 'DBIx::Custom::SQL::Template',
-    license             => 'perl',
-    dist_author         => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
-    dist_version_from   => 'lib/DBIx/Custom/SQL/Template.pm',
-    build_requires => {
-        'Test::More' => 0,
-    },
-    requires => {
-        'Object::Simple' => 2.0702,
-    },
-    add_to_cleanup      => [ 'DBIx-Custom-SQL-Template-*' ],
-    create_makefile_pl => 'traditional',
-);
-
-$builder->create_build_script();

-2

DBIx-Custom-SQL-Template/Changes

View

...	...	@@ -1,2 +0,0 @@
1		-0.0101
2		- First release

-15

DBIx-Custom-SQL-Template/MANIFEST.SKIP

View

@@ -1,15 +0,0 @@
-\bRCS\b
-\bCVS\b
-^MANIFEST\.
-^Makefile$
-^Build$
-^Build.bat$
-^_build/
-\.(bak|tdy|old|tmp)$
-~$
-^blib/
-^pm_to_blib
-\.cvsignore
-\.gz$
-^\.git
-^cover_db/

-15

DBIx-Custom-SQL-Template/README

View

@@ -1,15 +0,0 @@
-DBIx-Custom-SQL-Template
-
-SQL Template for DBIx::Custom
-
-INSTALLATION
-
-cpan DBIx::Custom::SQL::Template
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2009 Yuki Kimoto
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-696

DBIx-Custom-SQL-Template/lib/DBIx/Custom/SQL/Template.pm

View

@@ -1,696 +0,0 @@
-package DBIx::Custom::SQL::Template;
-use Object::Simple;
-
-our $VERSION = '0.0101';
-
-use Carp 'croak';
-
-# Accessor is created by Object::Simple. Please read Object::Simple document
-
-### Class-Object accessors
-
-# Tag start
-sub tag_start   : ClassObjectAttr {
-    initialize => {default => '{', clone => 'scalar'}
-}
-
-# Tag end
-sub tag_end     : ClassObjectAttr {
-    initialize => {default => '}', clone => 'scalar'}
-}
-
-# Tag syntax
-sub tag_syntax  : ClassObjectAttr {
-    initialize => {default => <<'EOS', clone => 'scalar'}}
-[tag]                     [expand]
-{? name}                  ?
-{= name}                  name = ?
-{<> name}                 name <> ?
-
-{< name}                  name < ?
-{> name}                  name > ?
-{>= name}                 name >= ?
-{<= name}                 name <= ?
-
-{like name}               name like ?
-{in name number}          name in [?, ?, ..]
-
-{insert key1 key2} (key1, key2) values (?, ?)
-{update key1 key2}    set key1 = ?, key2 = ?
-EOS
-
-# Tag processors
-sub tag_processors : ClassObjectAttr {
-    type => 'hash',
-    deref => 1,
-    initialize => {
-        clone => 'hash', 
-        default => sub {{
-            '?'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '='             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '<>'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '>'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '<'             => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '>='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            '<='            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            'like'          => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
-            'in'            => \&DBIx::Custom::SQL::Template::TagProcessor::expand_in_tag,
-            'insert'        => \&DBIx::Custom::SQL::Template::TagProcessor::expand_insert_tag,
-            'update'    => \&DBIx::Custom::SQL::Template::TagProcessor::expand_update_tag
-        }}
-    }
-}
-
-# Add Tag processor
-sub add_tag_processor {
-    my $invocant = shift;
-    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
-    $invocant->tag_processors(%{$invocant->tag_processors}, %{$tag_processors});
-    return $invocant;
-}
-
-# Clone
-sub clone {
-    my $self = shift;
-    my $new = $self->new;
-    
-    $new->tag_start($self->tag_start);
-    $new->tag_end($self->tag_end);
-    $new->tag_syntax($self->tag_syntax);
-    $new->tag_processors({%{$self->tag_processors || {}}});
-    
-    return $new;
-}
-
-
-### Object Methods
-
-# Create Query
-sub create_query {
-    my ($self, $template)  = @_;
-    
-    # Parse template
-    my $tree = $self->_parse_template($template);
-    
-    # Build query
-    my $query = $self->_build_query($tree);
-    
-    return $query;
-}
-
-# Parse template
-sub _parse_template {
-    my ($self, $template) = @_;
-    $template ||= '';
-    
-    my $tree = [];
-    
-    # Tags
-    my $tag_start = quotemeta $self->tag_start;
-    my $tag_end   = quotemeta $self->tag_end;
-    
-    # Tokenize
-    my $state = 'text';
-    
-    # Save original template
-    my $original_template = $template;
-    
-    # Parse template
-    while ($template =~ s/([^$tag_start]*?)$tag_start([^$tag_end].*?)$tag_end//sm) {
-        my $text = $1;
-        my $tag  = $2;
-        
-        # Parse tree
-        push @$tree, {type => 'text', tag_args => [$text]} if $text;
-        
-        if ($tag) {
-            # Get tag name and arguments
-            my ($tag_name, @tag_args) = split /\s+/, $tag;
-            
-            # Tag processor is exist?
-            unless ($self->tag_processors->{$tag_name}) {
-                my $tag_syntax = $self->tag_syntax;
-                croak("Tag '{$tag}' in SQL template is not exist.\n\n" .
-                      "<SQL template tag syntax>\n" .
-                      "$tag_syntax\n" .
-                      "<Your SQL template>\n" .
-                      "$original_template\n\n");
-            }
-            
-            # Check tag arguments
-            foreach my $tag_arg (@tag_args) {
-                # Cannot cantain placehosder '?'
-                croak("Tag '{t }' arguments cannot contain '?'")
-                  if $tag_arg =~ /\?/;
-            }
-            
-            # Add tag to parsing tree
-            push @$tree, {type => 'tag', tag_name => $tag_name, tag_args => [@tag_args]};
-        }
-    }
-    
-    # Add text to parsing tree 
-    push @$tree, {type => 'text', tag_args => [$template]} if $template;
-    
-    return $tree;
-}
-
-# Build SQL from parsing tree
-sub _build_query {
-    my ($self, $tree) = @_;
-    
-    # SQL
-    my $sql = '';
-    
-    # All parameter key infomation
-    my $all_key_infos = [];
-    
-    # Build SQL 
-    foreach my $node (@$tree) {
-        
-        # Get type, tag name, and arguments
-        my $type     = $node->{type};
-        my $tag_name = $node->{tag_name};
-        my $tag_args = $node->{tag_args};
-        
-        # Text
-        if ($type eq 'text') {
-            # Join text
-            $sql .= $tag_args->[0];
-        }
-        
-        # Tag
-        elsif ($type eq 'tag') {
-            
-            # Get tag processor
-            my $tag_processor = $self->tag_processors->{$tag_name};
-            
-            # Tag processor is code ref?
-            croak("Tag processor '$tag_name' must be code reference")
-              unless ref $tag_processor eq 'CODE';
-            
-            # Expand tag using tag processor
-            my ($expand, $key_infos)
-              = $tag_processor->($tag_name, $tag_args);
-            
-            # Check tag processor return value
-            croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)")
-              if !defined $expand || ref $key_infos ne 'ARRAY';
-            
-            # Check placeholder count
-            croak("Placeholder count in SQL created by tag processor '$tag_name' " .
-                  "must be same as key informations count")
-              unless $self->_placeholder_count($expand) eq @$key_infos;
-            
-            # Add key information
-            push @$all_key_infos, @$key_infos;
-            
-            # Join expand tag to SQL
-            $sql .= $expand;
-        }
-    }
-    
-    # Add semicolon
-    $sql .= ';' unless $sql =~ /;$/;
-    
-    # Query
-    my $query = {sql => $sql, key_infos => $all_key_infos};
-    
-    return $query;
-}
-
-# Get placeholder count
-sub _placeholder_count {
-    my ($self, $expand) = @_;
-    $expand ||= '';
-    
-    my $count = 0;
-    my $pos   = -1;
-    while (($pos = index($expand, '?', $pos + 1)) != -1) {
-        $count++;
-    }
-    return $count;
-}
-
-Object::Simple->build_class;
-
-
-package DBIx::Custom::SQL::Template::TagProcessor;
-use strict;
-use warnings;
-use Carp 'croak';
-
-# Expand tag '?', '=', '<>', '>', '<', '>=', '<=', 'like'
-sub expand_basic_tag {
-    my ($tag_name, $tag_args) = @_;
-    my $original_key = $tag_args->[0];
-    
-    # Key is not exist
-    croak("You must be pass key as argument to tag '{$tag_name }'")
-      if !$original_key;
-    
-    # Expanded tag
-    my $expand = $tag_name eq '?'
-               ? '?'
-               : "$original_key $tag_name ?";
-    
-    # Get table and clumn name
-    my ($table, $column) = get_table_and_column($original_key);
-    
-    # Parameter key infomation
-    my $key_info = {};
-    
-    # Original key
-    $key_info->{original_key} = $original_key;
-    
-    # Table
-    $key_info->{table}  = $table;
-    
-    # Column name
-    $key_info->{column} = $column;
-    
-    # Access keys
-    my $access_keys = [];
-    push @$access_keys, [$original_key];
-    push @$access_keys, [$table, $column] if $table && $column;
-    $key_info->{access_keys} = $access_keys;
-    
-    # Add parameter key information
-    my $key_infos = [];
-    push @$key_infos, $key_info;
-    
-    return ($expand, $key_infos);
-}
-
-# Expand tag 'in'
-sub expand_in_tag {
-    my ($tag_name, $tag_args) = @_;
-    my ($original_key, $placeholder_count) = @$tag_args;
-    
-    # Key must be specified
-    croak("You must be pass key as first argument of tag '{$tag_name }'\n" . 
-          "Usage: {$tag_name \$key \$placeholder_count}")
-      unless $original_key;
-      
-    
-    # Place holder count must be specified
-    croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" . 
-          "Usage: {$tag_name \$key \$placeholder_count}")
-      if !$placeholder_count || $placeholder_count =~ /\D/;
-
-    # Expand tag
-    my $expand = "$original_key $tag_name (";
-    for (my $i = 0; $i < $placeholder_count; $i++) {
-        $expand .= '?, ';
-    }
-    
-    $expand =~ s/, $//;
-    $expand .= ')';
-    
-    # Get table and clumn name
-    my ($table, $column) = get_table_and_column($original_key);
-    
-    # Create parameter key infomations
-    my $key_infos = [];
-    for (my $i = 0; $i < $placeholder_count; $i++) {
-        # Parameter key infomation
-        my $key_info = {};
-        
-        # Original key
-        $key_info->{original_key} = $original_key;
-        
-        # Table
-        $key_info->{table}   = $table;
-        
-        # Column name
-        $key_info->{column}  = $column;
-        
-        # Access keys
-        my $access_keys = [];
-        push @$access_keys, [$original_key, [$i]];
-        push @$access_keys, [$table, $column, [$i]] if $table && $column;
-        $key_info->{access_keys} = $access_keys;
-        
-        # Add parameter key infos
-        push @$key_infos, $key_info;
-    }
-    
-    return ($expand, $key_infos);
-}
-
-# Get table and column
-sub get_table_and_column {
-    my $key = shift;
-    $key ||= '';
-    
-    return ('', $key) unless $key =~ /\./;
-    
-    my ($table, $column) = split /\./, $key;
-    
-    return ($table, $column);
-}
-
-# Expand tag 'insert'
-sub expand_insert_tag {
-    my ($tag_name, $tag_args) = @_;
-    my $original_keys = $tag_args;
-    
-    # Insert key (k1, k2, k3, ..)
-    my $insert_keys = '(';
-    
-    # placeholder (?, ?, ?, ..)
-    my $place_holders = '(';
-    
-    foreach my $original_key (@$original_keys) {
-        # Get table and column
-        my ($table, $column) = get_table_and_column($original_key);
-        
-        # Join insert column
-        $insert_keys   .= "$column, ";
-        
-        # Join place holder
-        $place_holders .= "?, ";
-    }
-    
-    # Delete last ', '
-    $insert_keys =~ s/, $//;
-    
-    # Close 
-    $insert_keys .= ')';
-    $place_holders =~ s/, $//;
-    $place_holders .= ')';
-    
-    # Expand tag
-    my $expand = "$insert_keys values $place_holders";
-    
-    # Create parameter key infomations
-    my $key_infos = [];
-    foreach my $original_key (@$original_keys) {
-        # Get table and clumn name
-        my ($table, $column) = get_table_and_column($original_key);
-        
-        # Parameter key infomation
-        my $key_info = {};
-        
-        # Original key
-        $key_info->{original_key} = $original_key;
-        
-        # Table
-        $key_info->{table}   = $table;
-        
-        # Column name
-        $key_info->{column}  = $column;
-        
-        # Access keys
-        my $access_keys = [];
-        push @$access_keys, ['#insert', $original_key];
-        push @$access_keys, ['#insert', $table, $column] if $table && $column;
-        push @$access_keys, [$original_key];
-        push @$access_keys, [$table, $column] if $table && $column;
-        $key_info->{access_keys} = $access_keys;
-        
-        # Add parameter key infos
-        push @$key_infos, $key_info;
-    }
-    
-    return ($expand, $key_infos);
-}
-
-# Expand tag 'update'
-sub expand_update_tag {
-    my ($tag_name, $tag_args) = @_;
-    my $original_keys = $tag_args;
-    
-    # Expanded tag
-    my $expand = 'set ';
-    
-    # 
-    foreach my $original_key (@$original_keys) {
-        # Get table and clumn name
-        my ($table, $column) = get_table_and_column($original_key);
-
-        # Join key and placeholder
-        $expand .= "$column = ?, ";
-    }
-    
-    # Delete last ', '
-    $expand =~ s/, $//;
-    
-    # Create parameter key infomations
-    my $key_infos = [];
-    foreach my $original_key (@$original_keys) {
-        # Get table and clumn name
-        my ($table, $column) = get_table_and_column($original_key);
-        
-        # Parameter key infomation
-        my $key_info = {};
-        
-        # Original key
-        $key_info->{original_key} = $original_key;
-        
-        # Table
-        $key_info->{table}  = $table;
-        
-        # Column name
-        $key_info->{column} = $column;
-        
-        # Access keys
-        my $access_keys = [];
-        push @$access_keys, ['#update', $original_key];
-        push @$access_keys, ['#update', $table, $column] if $table && $column;
-        push @$access_keys, [$original_key];
-        push @$access_keys, [$table, $column] if $table && $column;
-        $key_info->{access_keys} = $access_keys;
-        
-        # Add parameter key infos
-        push @$key_infos, $key_info;
-    }
-    
-    return ($expand, $key_infos);
-}
-
-1;
-
-=head1 NAME
-
-DBIx::Custom::SQL::Template - Custamizable SQL Template for DBIx::Custom
-
-=head1 VERSION
-
-Version 0.0101
-
-=cut
-
-=head1 SYNOPSIS
-    
-    my $sql_tmpl = DBIx::Custom::SQL::Template->new;
-    
-    my $tmpl   = "select from table {= k1} && {<> k2} || {like k3}";
-    my $param = {k1 => 1, k2 => 2, k3 => 3};
-    
-    my $query = $sql_template->create_query($tmpl);
-    
-    
-    # Using query from DBIx::Custom
-    use DBIx::Custom;
-    my $dbi = DBI->new(
-       data_source => $data_source,
-       user        => $user,
-       password    => $password, 
-       dbi_options => {PrintError => 0, RaiseError => 1}
-    );
-    
-    $query = $dbi->create_query($tmpl); # This is SQL::Template create_query
-    $dbi->query($query, $param);
-
-=head1 CLASS-OBJECT ACCESSORS
-
-Class-Object accessor is used from both object and class
-
-    $class->$accessor # call from class
-    $self->$accessor  # call form object
-
-=head2 tag_processors
-
-    # Set and get
-    $self           = $sql_tmpl->tag_processors($tag_processors);
-    $tag_processors = $sql_tmpl->tag_processors;
-    
-    # Sample
-    $sql_tmpl->tag_processors(
-        '?' => \&expand_question,
-        '=' => \&expand_equel
-    );
-
-You can use add_tag_processor to add tag processor
-
-=head2 tag_start
-
-    # Set and get
-    $self      = $sql_tmpl->tag_start($tag_start);
-    $tag_start = $sql_tmpl->tag_start;
-    
-    # Sample
-    $sql_tmpl->tag_start('{');
-
-Default is '{'
-
-=head2 tag_end
-
-    # Set and get
-    $self    = $sql_tmpl->tag_start($tag_end);
-    $tag_end = $sql_tmpl->tag_start;
-    
-    # Sample
-    $sql_tmpl->tag_start('}');
-
-Default is '}'
-    
-=head2 tag_syntax
-    
-    # Set and get
-    $self       = $sql_tmpl->tag_syntax($tag_syntax);
-    $tag_syntax = $sql_tmpl->tag_syntax;
-    
-    # Sample
-    $sql_tmpl->tag_syntax(
-        "[Tag]            [Expand]\n" .
-        "{? name}         ?\n" .
-        "{= name}         name = ?\n" .
-        "{<> name}        name <> ?\n"
-    );
-
-=head1 METHODS
-
-=head2 create_query
-    
-    # Create SQL form SQL template
-    $query = $sql_tmpl->create_query($tmpl);
-    
-    # Sample
-    $query = $sql_tmpl->create_sql(
-         "select * from table where {= title} && {like author} || {<= price}")
-    
-    # Result
-    $qeury->{sql} : "select * from table where title = ? && author like ? price <= ?;"
-    $query->{key_infos} : [['title'], ['author'], ['price']]
-    
-    # Sample2 (with table name)
-    ($sql, @bind_values) = $sql_tmpl->create_sql(
-            "select * from table where {= table.title} && {like table.author}",
-            {table => {title => 'Perl', author => '%Taro%'}}
-        )
-    
-    # Result2
-    $query->{sql} : "select * from table where table.title = ? && table.title like ?;"
-    $query->{key_infos} :[ [['table.title'],['table', 'title']],
-                           [['table.author'],['table', 'author']] ]
-
-This method create query using by DBIx::Custom.
-query is two infomation
-
-    1.sql       : SQL
-    2.key_infos : Parameter access key information
-
-=head2 add_tag_processor
-
-Add tag processor
-  
-    # Add
-    $self = $sql_tmpl->add_tag_processor($tag_processor);
-    
-    # Sample
-    $sql_tmpl->add_tag_processor(
-        '?' => sub {
-            my ($tag_name, $tag_args) = @_;
-            
-            my $key1 = $tag_args->[0];
-            my $key2 = $tag_args->[1];
-            
-            my $key_infos = [];
-            
-            # Expand tag and create key informations
-            
-            # Return expand tags and key informations
-            return ($expand, $key_infos);
-        }
-    );
-
-Tag processor recieve 2 argument
-
-    1. Tag name            (?, =, <>, or etc)
-    2. Tag arguments       (arg1 and arg2 in {tag_name arg1 arg2})
-
-Tag processor return 2 value
-
-    1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?')
-    2. Key infomations
-    
-You must be return expanded tag and key infomations.
-
-Key information is a little complex. so I will explan this in future.
-
-If you want to know more, Please see DBIx::Custom::SQL::Template source code.
-
-=head2 clone
-
-    # Clone DBIx::Custom::SQL::Template object
-    $clone = $self->clone;
-    
-=head1 Available Tags
-    
-    # Available Tags
-    [tag]            [expand]
-    {? name}         ?
-    {= name}         name = ?
-    {<> name}        name <> ?
-    
-    {< name}         name < ?
-    {> name}         name > ?
-    {>= name}        name >= ?
-    {<= name}        name <= ?
-    
-    {like name}      name like ?
-    {in name}        name in [?, ?, ..]
-    
-    {insert}  (key1, key2, key3) values (?, ?, ?)
-    {update}     set key1 = ?, key2 = ?, key3 = ?
-    
-    # Sample1
-    $query = $sql_tmpl->create_sql(
-        "insert into table {insert key1 key2}"
-    );
-    # Result1
-    $sql : "insert into table (key1, key2) values (?, ?)"
-    
-    
-    # Sample2
-    $query = $sql_tmpl->create_sql(
-        "update table {update key1 key2} where {= key3}"
-    );
-    
-    # Result2
-    $query->{sql} : "update table set key1 = ?, key2 = ? where key3 = ?;"
-    
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github 
-L<http://github.com/yuki-kimoto>
-L<http://github.com/yuki-kimoto/DBIx-Custom-SQL-Template>
-
-Please let know me bag if you find
-Please request me if you want to do something
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-
-=cut
-
-1; # End of DBIx::Custom::SQL::Template

-9

DBIx-Custom-SQL-Template/t/00-load.t

View

@@ -1,9 +0,0 @@
-#!perl -T
-
-use Test::More tests => 1;
-
-BEGIN {
-	use_ok( 'DBIx::Custom::SQL::Template' );
-}
-
-diag( "Testing DBIx::Custom::SQL::Template $DBIx::Custom::SQL::Template::VERSION, Perl $], $^X" );

-236

DBIx-Custom-SQL-Template/t/01-core.t

View

@@ -1,236 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More 'no_plan';
-
-use DBIx::Custom::SQL::Template;
-
-# Function for test name
-my $test;
-sub test{
-    $test = shift;
-}
-
-# Variable for test
-my $datas;
-my $sql_tmpl;
-my $query;
-my $ret_val;
-my $clone;
-
-test "Various template pattern";
-$datas = [
-    # Basic tests
-    {   name            => 'placeholder basic',
-        tmpl            => "a {?  k1} b {=  k2} {<> k3} {>  k4} {<  k5} {>= k6} {<= k7} {like k8}", ,
-        sql_expected    => "a ? b k2 = ? k3 <> ? k4 > ? k5 < ? k6 >= ? k7 <= ? k8 like ?;",
-        key_infos_expected   => [
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1']]},
-            {original_key => 'k2', table => '', column => 'k2', access_keys => [['k2']]},
-            {original_key => 'k3', table => '', column => 'k3', access_keys => [['k3']]},
-            {original_key => 'k4', table => '', column => 'k4', access_keys => [['k4']]},
-            {original_key => 'k5', table => '', column => 'k5', access_keys => [['k5']]},
-            {original_key => 'k6', table => '', column => 'k6', access_keys => [['k6']]},
-            {original_key => 'k7', table => '', column => 'k7', access_keys => [['k7']]},
-            {original_key => 'k8', table => '', column => 'k8', access_keys => [['k8']]},
-        ],
-    },
-    {
-        name            => 'placeholder in',
-        tmpl            => "{in k1 3};",
-        sql_expected    => "k1 in (?, ?, ?);",
-        key_infos_expected   => [
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [0]]]},
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [1]]]},
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [2]]]},
-        ],
-    },
-    {
-        name            => 'insert',
-        tmpl            => "{insert k1 k2 k3}",
-        sql_expected    => "(k1, k2, k3) values (?, ?, ?);",
-        key_infos_expected   => [
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['#insert', 'k1'], ['k1']]},
-            {original_key => 'k2', table => '', column => 'k2', access_keys => [['#insert', 'k2'], ['k2']]},
-            {original_key => 'k3', table => '', column => 'k3', access_keys => [['#insert', 'k3'], ['k3']]},
-        ],
-    },
-    {
-        name            => 'update',
-        tmpl            => "{update k1 k2 k3}",
-        sql_expected    => "set k1 = ?, k2 = ?, k3 = ?;",
-        key_infos_expected   => [
-            {original_key => 'k1', table => '', column => 'k1', access_keys => [['#update', 'k1'], ['k1']]},
-            {original_key => 'k2', table => '', column => 'k2', access_keys => [['#update', 'k2'], ['k2']]},
-            {original_key => 'k3', table => '', column => 'k3', access_keys => [['#update', 'k3'], ['k3']]},
-        ],
-    },
-    
-    # Table name
-    {
-        name            => 'placeholder with table name',
-        tmpl            => "{= a.k1} {= a.k2}",
-        sql_expected    => "a.k1 = ? a.k2 = ?;",
-        key_infos_expected  => [
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1'], ['a', 'k1']]},
-            {original_key => 'a.k2', table => 'a', column => 'k2', access_keys => [['a.k2'], ['a', 'k2']]},
-        ],
-    },
-    {   
-        name            => 'placeholder in with table name',
-        tmpl            => "{in a.k1 2} {in b.k2 2}",
-        sql_expected    => "a.k1 in (?, ?) b.k2 in (?, ?);",
-        key_infos_expected  => [
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [0]], ['a', 'k1', [0]]]},
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [1]], ['a', 'k1', [1]]]},
-            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [0]], ['b', 'k2', [0]]]},
-            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [1]], ['b', 'k2', [1]]]},
-        ],
-    },
-    {
-        name            => 'insert with table name',
-        tmpl            => "{insert a.k1 b.k2}",
-        sql_expected    => "(k1, k2) values (?, ?);",
-        key_infos_expected  => [
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['#insert', 'a.k1'], ['#insert', 'a', 'k1'], ['a.k1'], ['a', 'k1']]},
-            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['#insert', 'b.k2'], ['#insert', 'b', 'k2'], ['b.k2'], ['b', 'k2']]},
-        ],
-    },
-    {
-        name            => 'update with table name',
-        tmpl            => "{update a.k1 b.k2}",
-        sql_expected    => "set k1 = ?, k2 = ?;",
-        key_infos_expected  => [
-            {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['#update', 'a.k1'], ['#update', 'a', 'k1'], ['a.k1'], ['a', 'k1']]},
-            {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['#update', 'b.k2'], ['#update', 'b', 'k2'], ['b.k2'], ['b', 'k2']]},
-        ],
-    },
-    {
-        name            => 'not contain tag',
-        tmpl            => "aaa",
-        sql_expected    => "aaa;",
-        key_infos_expected  => [],
-    }
-];
-
-for (my $i = 0; $i < @$datas; $i++) {
-    my $data = $datas->[$i];
-    my $sql_tmpl = DBIx::Custom::SQL::Template->new;
-    my $query = $sql_tmpl->create_query($data->{tmpl});
-    is($query->{sql}, $data->{sql_expected}, "$test : $data->{name} : sql");
-    is_deeply($query->{key_infos}, $data->{key_infos_expected}, "$test : $data->{name} : key_infos");
-}
-
-
-test 'Original tag processor';
-$sql_tmpl = DBIx::Custom::SQL::Template->new;
-
-$ret_val = $sql_tmpl->add_tag_processor(
-    p => sub {
-        my ($tag_name, $args) = @_;
-        
-        my $expand    = "$tag_name ? $args->[0] $args->[1]";
-        my $key_infos = [2];
-        return ($expand, $key_infos);
-    }
-);
-
-$query = $sql_tmpl->create_query("{p a b}");
-is($query->{sql}, "p ? a b;", "$test : add_tag_processor sql");
-is_deeply($query->{key_infos}, [2], "$test : add_tag_processor key_infos");
-isa_ok($ret_val, 'DBIx::Custom::SQL::Template');
-
-
-test "Tag processor error case";
-$sql_tmpl = DBIx::Custom::SQL::Template->new;
-
-
-eval{$sql_tmpl->create_query("{a }")};
-like($@, qr/Tag '{a }' in SQL template is not exist/, "$test : tag_processor not exist");
-
-$sql_tmpl->add_tag_processor({
-    q => 'string'
-});
-
-eval{$sql_tmpl->create_query("{q}", {})};
-like($@, qr/Tag processor 'q' must be code reference/, "$test : tag_processor not code ref");
-
-$sql_tmpl->add_tag_processor({
-   r => sub {} 
-});
-
-eval{$sql_tmpl->create_query("{r}")};
-like($@, qr/\QTag processor 'r' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return noting");
-
-$sql_tmpl->add_tag_processor({
-   s => sub { return ("a", "")} 
-});
-
-eval{$sql_tmpl->create_query("{s}")};
-like($@, qr/\QTag processor 's' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return not array key_infos");
-
-$sql_tmpl->add_tag_processor(
-    t => sub {return ("a", [])}
-);
-
-eval{$sql_tmpl->create_query("{t ???}")};
-like($@, qr/Tag '{t }' arguments cannot contain '?'/, "$test : cannot contain '?' in tag argument");
-
-
-test 'General error case';
-$sql_tmpl = DBIx::Custom::SQL::Template->new;
-$sql_tmpl->add_tag_processor(
-    a => sub {
-        return ("? ? ?", [[],[]]);
-    }
-);
-eval{$sql_tmpl->create_query("{a}")};
-like($@, qr/Placeholder count in SQL created by tag processor 'a' must be same as key informations count/, "$test placeholder count is invalid");
-
-
-test 'Default tag processor Error case';
-eval{$sql_tmpl->create_query("{= }")};
-like($@, qr/You must be pass key as argument to tag '{= }'/, "$test : basic '=' : key not exist");
-
-eval{$sql_tmpl->create_query("{in }")};
-like($@, qr/You must be pass key as first argument of tag '{in }'/, "$test : in : key not exist");
-
-eval{$sql_tmpl->create_query("{in a}")};
-like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
-     "$test : in : key not exist");
-
-eval{$sql_tmpl->create_query("{in a r}")};
-like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
-     "$test : in : key not exist");
-
-
-test 'Clone';
-$sql_tmpl = DBIx::Custom::SQL::Template->new;
-$sql_tmpl
-  ->tag_start('[')
-  ->tag_end(']')
-  ->tag_syntax('syntax')
-  ->tag_processors({a => 1, b => 2});
-
-$clone = $sql_tmpl->clone;
-is($clone->tag_start, $sql_tmpl->tag_start, "$test : tag_start");
-is($clone->tag_end, $sql_tmpl->tag_end, "$test : tag_end");
-is($clone->tag_syntax, $sql_tmpl->tag_syntax, "$test : tag_syntax");
-
-is_deeply( scalar $clone->tag_processors, scalar $sql_tmpl->tag_processors,
-          "$test : tag_processors deep clone");
-
-isnt($clone->tag_processors, $sql_tmpl->tag_processors, 
-     "$test : tag_processors reference not copy");
-
-$sql_tmpl->tag_processors(undef);
-
-$clone = $sql_tmpl->clone;
-is_deeply(scalar $clone->tag_processors, {}, "$test tag_processor undef copy");
-
-
-
-__END__
-
-
-

-51

DBIx-Custom-SQL-Template/t/boilerplate.t

View

@@ -1,51 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-sub not_in_file_ok {
-    my ($filename, %regex) = @_;
-    open( my $fh, '<', $filename )
-        or die "couldn't open $filename for reading: $!";
-
-    my %violated;
-
-    while (my $line = <$fh>) {
-        while (my ($desc, $regex) = each %regex) {
-            if ($line =~ $regex) {
-                push @{$violated{$desc}||=[]}, $.;
-            }
-        }
-    }
-
-    if (%violated) {
-        fail("$filename contains boilerplate text");
-        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
-    } else {
-        pass("$filename contains no boilerplate text");
-    }
-}
-
-sub module_boilerplate_ok {
-    my ($module) = @_;
-    not_in_file_ok($module =>
-        'the great new $MODULENAME'   => qr/ - The great new /,
-        'boilerplate description'     => qr/Quick summary of what the module/,
-        'stub function definition'    => qr/function[12]/,
-    );
-}
-
-
-  not_in_file_ok(README =>
-    "The README is used..."       => qr/The README is used/,
-    "'version information here'"  => qr/to provide version information/,
-  );
-
-  not_in_file_ok(Changes =>
-    "placeholder date/time"       => qr(Date/time)
-  );
-
-  module_boilerplate_ok('lib/DBIx/Custom/SQL/Template.pm');
-
-

-18

DBIx-Custom-SQL-Template/t/pod-coverage.t

View

@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
-    if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
-    if $@;
-
-all_pod_coverage_ok(also_private => [qw//]);

-12

DBIx-Custom-SQL-Template/t/pod.t

View

@@ -1,12 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod
-my $min_tp = 1.22;
-eval "use Test::Pod $min_tp";
-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
-
-all_pod_files_ok();

-10

DBIx-Custom-SQLite/.cvsignore

View

@@ -1,10 +0,0 @@
-blib*
-Makefile
-Makefile.old
-Build
-_build*
-pm_to_blib*
-*.tar.gz
-.lwpcookies
-DBIx-Custom-SQLite-*
-cover_db

-11

DBIx-Custom-SQLite/.gitignore

View

@@ -1,11 +0,0 @@
-*.bak
-*.BAK
-Build
-MANIFEST
-META.yml
-Makefile.PL
-_build/*
-blib/*
-*.tar.gz
-cover_db/*
-*.tmp

-21

DBIx-Custom-SQLite/Build.PL

View

@@ -1,21 +0,0 @@
-use strict;
-use warnings;
-use Module::Build;
-
-my $builder = Module::Build->new(
-    module_name         => 'DBIx::Custom::SQLite',
-    license             => 'perl',
-    dist_author         => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
-    dist_version_from   => 'lib/DBIx/Custom/SQLite.pm',
-    build_requires => {
-        'Test::More' => 0,
-    },
-    requires => {
-        'DBIx::Custom::Basic' => 0.0101,
-        'DBD::SQLite' => 1.25
-    },
-    add_to_cleanup      => [ 'DBIx-Custom-SQLite-*' ],
-    create_makefile_pl => 'traditional',
-);
-
-$builder->create_build_script();

-6

DBIx-Custom-SQLite/Changes

View

@@ -1,6 +0,0 @@
-0.0201
-  catch up DBIx::Custom::Result version up
-0.0102
-  update document
-0.0101
-  First release

-15

DBIx-Custom-SQLite/MANIFEST.SKIP

View

@@ -1,15 +0,0 @@
-\bRCS\b
-\bCVS\b
-^MANIFEST\.
-^Makefile$
-^Build$
-^Build.bat$
-^_build/
-\.(bak|tdy|old|tmp)$
-~$
-^blib/
-^pm_to_blib
-\.cvsignore
-\.gz$
-^\.git
-^cover_db/

-15

DBIx-Custom-SQLite/README

View

@@ -1,15 +0,0 @@
-DBIx-Custom-SQLite
-
-DBIx::Custom SQLite implementation
-
-INSTALLATION
-
-cpan DBIx::Custom::SQLite
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2009 Yuki Kimoto
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-138

DBIx-Custom-SQLite/lib/DBIx/Custom/SQLite.pm

View

@@ -1,138 +0,0 @@
-package DBIx::Custom::SQLite;
-use base 'DBIx::Custom::Basic';
-
-use warnings;
-use strict;
-use Carp 'croak';
-
-our $VERSION = '0.0201';
-
-my $class = __PACKAGE__;
-
-$class->add_format(
-    datetime => $class->formats->{SQL99_datetime},
-    date     => $class->formats->{SQL99_date},
-    time     => $class->formats->{SQL99_time},
-);
-
-sub connect {
-    my $self = shift;
-    
-    if (!$self->data_source && (my $database = $self->database)) {
-        $self->data_source("dbi:SQLite:dbname=$database");
-    }
-    
-    return $self->SUPER::connect;
-}
-
-sub connect_memory {
-    my $self = shift;
-    
-    # Data source for memory database
-    $self->data_source('dbi:SQLite:dbname=:memory:');
-    
-    # Already connected
-    croak("Already connected") if $self->connected;
-    
-    # Connect
-    $self->connect;
-    
-    return $self;
-}
-
-sub reconnect_memory {
-    my $self = shift;
-
-    # Data source for memory database
-    $self->data_source('dbi:SQLite:dbname=:memory:');
-    
-    # Reconnect
-    $self->reconnect;
-    
-    return $self;
-}
-
-
-=head1 NAME
-
-DBIx::Custom::SQLite - DBIx::Custom SQLite implementation
-
-=head1 Version
-
-Version 0.0201
-
-=head1 Synopsys
-
-    use DBIx::Custom::SQLite;
-    
-    # New
-    my $dbi = DBIx::Custom::SQLite->new(user => 'taro', $password => 'kliej&@K',
-                                       database => 'sample.db');
-    
-    # Insert 
-    $dbi->insert('books', {title => 'perl', author => 'taro'});
-    
-    # Update 
-    # same as 'update books set (title = 'aaa', author = 'ken') where id = 5;
-    $dbi->update('books', {title => 'aaa', author => 'ken'}, {id => 5});
-    
-    # Delete
-    $dbi->delete('books', {author => 'taro'});
-    
-    # select * from books;
-    $dbi->select('books');
-    
-    # select * from books where ahthor = 'taro'; 
-    $dbi->select('books', {author => 'taro'}); 
-    
-    # select author, title from books where author = 'taro'
-    $dbi->select('books', [qw/author title/], {author => 'taro'});
-    
-    # select author, title from books where author = 'taro' order by id limit 1;
-    $dbi->select('books', [qw/author title/], {author => 'taro'},
-                 'order by id limit 1');
-
-=head1 See DBIx::Custom and DBI::Custom::Basic documentation
-
-This class is L<DBIx::Custom::Basic> subclass.
-and L<DBIx::Custom::Basic> is L<DBIx::Custom> subclass
-
-You can use all methods of L<DBIx::Custom::Basic> and <DBIx::Custom>
-Please see L<DBIx::Custom::Basic> and <DBIx::Custom> documentation
-
-=head1 Object methods
-
-=head2 connect
-
-This override L<DBIx::Custom> connect.
-
-    # Connect to database
-    $dbi->connect;
-
-If database attribute is set, automatically data source is created and connect
-
-=head2 connect_memory
-
-    # Connect memory database
-    $self = $dbi->connect_memory;
-
-=head2 reconnect_memory
-
-    # Reconnect memory database
-    $self = $dbi->reconnect_memory;
-
-=head1 Author
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
-
-=head1 Copyright & lisence
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-9

DBIx-Custom-SQLite/t/00-load.t

View

@@ -1,9 +0,0 @@
-#!perl -T
-
-use Test::More tests => 1;
-
-BEGIN {
-	use_ok( 'DBIx::Custom::SQLite' );
-}
-
-diag( "Testing DBIx::Custom::SQLite $DBIx::Custom::SQLite::VERSION, Perl $], $^X" );

-61

DBIx-Custom-SQLite/t/01-core.t

View

@@ -1,61 +0,0 @@
-use Test::More 'no_plan';
-use strict;
-use warnings;
-use utf8;
-
-use DBIx::Custom::SQLite;
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Constant varialbes for test
-my $CREATE_TABLE = {
-    0 => 'create table table1 (key1 char(255), key2 char(255));',
-    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
-    2 => 'create table table2 (key1 char(255), key3 char(255));'
-};
-
-
-# Variables for tests
-my $dbi;
-my $ret_val;
-my $rows;
-my $db_file;
-
-test 'connect_memory';
-$dbi = DBIx::Custom::SQLite->new;
-$dbi->connect_memory;
-$ret_val = $dbi->do($CREATE_TABLE->{0});
-ok(defined $ret_val, $test);
-$dbi->utf8_filter_on;
-$dbi->insert('table1', {key1 => 'あ', key2 => 2});
-$rows = $dbi->select('table1', {key1 => 'あ'})->fetch_hash_all;
-is_deeply($rows, [{key1 => 'あ', key2 => 2}], "$test : select rows");
-
-test 'connect_memory error';
-eval{$dbi->connect_memory};
-like($@, qr/Already connected/, "$test : already connected");
-
-test 'reconnect_memory';
-$dbi = DBIx::Custom::SQLite->new;
-$dbi->reconnect_memory;
-$ret_val = $dbi->do($CREATE_TABLE->{0});
-ok(defined $ret_val, "$test : connect first");
-$dbi->reconnect_memory;
-$ret_val = $dbi->do($CREATE_TABLE->{2});
-ok(defined $ret_val, "$test : connect first");
-
-test 'connect';
-$db_file  = 't/test.db';
-unlink $db_file if -f $db_file;
-$dbi = DBIx::Custom::SQLite->new(database => $db_file);
-$dbi->connect;
-ok(-f $db_file, "$test : database file");
-$ret_val = $dbi->do($CREATE_TABLE->{0});
-ok(defined $ret_val, "$test : database");
-$dbi->disconnect;
-unlink $db_file if -f $db_file;
-

-82

DBIx-Custom-SQLite/t/02-time_format.t

View

@@ -1,82 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-BEGIN {
-    eval { require Time::Piece; 1 }
-        or plan skip_all => 'Time::Piece required';
-    
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Varialbe for tests
-
-my $format;
-my $data;
-my $timepiece;
-my $dbi;
-
-use DBIx::Custom::SQLite;
-
-
-test 'SQL99 format';
-$dbi = DBIx::Custom::SQLite->new;
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'SQL99_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'SQL99_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'SQL99_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'ISO-8601 format';
-$data   = '2009-01-02T03:04:05';
-$format = $dbi->formats->{'ISO-8601_datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'ISO-8601_date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'ISO-8601_time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-
-
-test 'default format';
-$data   = '2009-01-02 03:04:05';
-$format = $dbi->formats->{'datetime'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
-is($timepiece->strftime('%T'), '03:04:05',  "$test : datetime time");
-
-$data   = '2009-01-02';
-$format = $dbi->formats->{'date'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
-
-$data   = '03:04:05';
-$format = $dbi->formats->{'time'};
-$timepiece = Time::Piece->strptime($data, $format);
-is($timepiece->strftime('%T'), '03:04:05',  "$test : time");
-

-50

DBIx-Custom-SQLite/t/boilerplate.t

View

@@ -1,50 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-sub not_in_file_ok {
-    my ($filename, %regex) = @_;
-    open( my $fh, '<', $filename )
-        or die "couldn't open $filename for reading: $!";
-
-    my %violated;
-
-    while (my $line = <$fh>) {
-        while (my ($desc, $regex) = each %regex) {
-            if ($line =~ $regex) {
-                push @{$violated{$desc}||=[]}, $.;
-            }
-        }
-    }
-
-    if (%violated) {
-        fail("$filename contains boilerplate text");
-        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
-    } else {
-        pass("$filename contains no boilerplate text");
-    }
-}
-
-sub module_boilerplate_ok {
-    my ($module) = @_;
-    not_in_file_ok($module =>
-        'the great new $MODULENAME'   => qr/ - The great new /,
-        'boilerplate description'     => qr/Quick summary of what the module/,
-        'stub function definition'    => qr/function[12]/,
-    );
-}
-
-  not_in_file_ok(README =>
-    "The README is used..."       => qr/The README is used/,
-    "'version information here'"  => qr/to provide version information/,
-  );
-
-  not_in_file_ok(Changes =>
-    "placeholder date/time"       => qr(Date/time)
-  );
-
-  module_boilerplate_ok('lib/DBIx/Custom/SQLite.pm');
-
-

-18

DBIx-Custom-SQLite/t/pod-coverage.t

View

@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
-    if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
-    if $@;
-
-all_pod_coverage_ok();

-12

DBIx-Custom-SQLite/t/pod.t

View

@@ -1,12 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod
-my $min_tp = 1.22;
-eval "use Test::Pod $min_tp";
-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
-
-all_pod_files_ok();

-11

DBIx-Custom/.gitignore

View

@@ -1,11 +0,0 @@
-*.bak
-*.BAK
-Build
-MANIFEST
-META.yml
-Makefile.PL
-_build/*
-blib/*
-*.tar.gz
-cover_db/*
-*.tmp

-27

DBIx-Custom/Build.PL

View

@@ -1,27 +0,0 @@
-use strict;
-use warnings;
-use Module::Build;
-
-my $builder = Module::Build->new(
-    module_name         => 'DBIx::Custom',
-    license             => 'perl',
-    dist_author         => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
-    dist_version_from   => 'lib/DBIx/Custom.pm',
-    build_requires => {
-        'Test::More' => 0,
-    },
-    recommends => {
-        'DBD::SQLite' => '1.25'
-    },
-    requires => {
-        'Object::Simple' => 2.0702,
-        'DBI'            => 1.605,
-        'DBIx::Custom::Query' => 0.0101,
-        'DBIx::Custom::Result' => 0.0101,
-        'DBIx::Custom::SQL::Template' => 0.0101
-    },
-    add_to_cleanup      => [ 'DBIx-Custom-*' ],
-    create_makefile_pl => 'traditional',
-);
-
-$builder->create_build_script();

-9

DBIx-Custom/Changes

View

@@ -1,9 +0,0 @@
-0.0401
-  catch up with DBIx::Custom::Result version up
-0.0301
-  exchange filter argument 'key', 'value' (not backword compatible)
-0.0201
-  rename tranzaction to transaction
-  add filter_off
-0.0101
-  First release

-15

DBIx-Custom/MANIFEST.SKIP

View

@@ -1,15 +0,0 @@
-\bRCS\b
-\bCVS\b
-^MANIFEST\.
-^Makefile$
-^Build$
-^Build.bat$
-^_build/
-\.(bak|tdy|old|tmp)$
-~$
-^blib/
-^pm_to_blib
-\.cvsignore
-\.gz$
-^\.git
-^cover_db/

-15

DBIx-Custom/README

View

@@ -1,15 +0,0 @@
-DBIx-Custom
-
-Custamizable DBI
-
-INSTALLATION
-
-cpan DBIx::Custom
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2009 Yuki Kimoto
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-

-1125

DBIx-Custom/lib/DBIx/Custom.pm

View

@@ -1,1125 +0,0 @@
-package DBIx::Custom;
-use Object::Simple;
-
-our $VERSION = '0.0401';
-
-use Carp 'croak';
-use DBI;
-use DBIx::Custom::Query;
-use DBIx::Custom::Result;
-use DBIx::Custom::SQL::Template;
-
-
-### Class-Object Accessors
-sub user        : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub password    : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub data_source : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub dbi_options : ClassObjectAttr { initialize => {clone => 'hash', 
-                                                   default => sub { {} } } }
-sub database    : ClassObjectAttr { initialize => {clone => 'scalar'} }
-
-sub bind_filter  : ClassObjectAttr { initialize => {clone => 'scalar'} }
-sub fetch_filter : ClassObjectAttr { initialize => {clone => 'scalar'} }
-
-sub no_bind_filters   : ClassObjectAttr { initialize => {clone => 'array'} }
-sub no_fetch_filters  : ClassObjectAttr { initialize => {clone => 'array'} }
-
-sub filters : ClassObjectAttr {
-    type => 'hash',
-    deref => 1,
-    initialize => {
-        clone   => 'hash',
-        default => sub { {} }
-    }
-}
-
-sub formats : ClassObjectAttr {
-    type => 'hash',
-    deref => 1,
-    initialize => {
-        clone   => 'hash',
-        default => sub { {} }
-    }
-}
-
-sub result_class : ClassObjectAttr {
-    initialize => {
-        clone   => 'scalar',
-        default => 'DBIx::Custom::Result'
-    }
-}
-
-sub sql_template : ClassObjectAttr {
-    initialize => {
-        clone   => sub {$_[0] ? $_[0]->clone : undef},
-        default => sub {DBIx::Custom::SQL::Template->new}
-    }
-}
-
-### Object Accessor
-sub dbh          : Attr {}
-
-
-### Methods
-
-# Add filter
-sub add_filter {
-    my $invocant = shift;
-    
-    my %old_filters = $invocant->filters;
-    my %new_filters = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
-    $invocant->filters(%old_filters, %new_filters);
-    return $invocant;
-}
-
-# Add format
-sub add_format{
-    my $invocant = shift;
-    
-    my %old_formats = $invocant->formats;
-    my %new_formats = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
-    $invocant->formats(%old_formats, %new_formats);
-    return $invocant;
-}
-
-# Auto commit
-sub _auto_commit {
-    my $self = shift;
-    
-    croak("Not yet connect to database") unless $self->dbh;
-    
-    if (@_) {
-        $self->dbh->{AutoCommit} = $_[0];
-        return $self;
-    }
-    return $self->dbh->{AutoCommit};
-}
-
-# Connect
-sub connect {
-    my $self = shift;
-    my $data_source = $self->data_source;
-    my $user        = $self->user;
-    my $password    = $self->password;
-    my $dbi_options  = $self->dbi_options;
-    
-    my $dbh = eval{DBI->connect(
-        $data_source,
-        $user,
-        $password,
-        {
-            RaiseError => 1,
-            PrintError => 0,
-            AutoCommit => 1,
-            %{$dbi_options || {} }
-        }
-    )};
-    
-    croak $@ if $@;
-    
-    $self->dbh($dbh);
-    return $self;
-}
-
-# DESTROY
-sub DESTROY {
-    my $self = shift;
-    $self->disconnect if $self->connected;
-}
-
-# Is connected?
-sub connected {
-    my $self = shift;
-    return ref $self->{dbh} eq 'DBI::db';
-}
-
-# Disconnect
-sub disconnect {
-    my $self = shift;
-    if ($self->connected) {
-        $self->dbh->disconnect;
-        delete $self->{dbh};
-    }
-}
-
-# Reconnect
-sub reconnect {
-    my $self = shift;
-    $self->disconnect if $self->connected;
-    $self->connect;
-}
-
-# Prepare statement handle
-sub prepare {
-    my ($self, $sql) = @_;
-    
-    # Connect if not
-    $self->connect unless $self->connected;
-    
-    # Prepare
-    my $sth = eval{$self->dbh->prepare($sql)};
-    
-    # Error
-    croak("$@<Your SQL>\n$sql") if $@;
-    
-    return $sth;
-}
-
-# Execute SQL directly
-sub do{
-    my ($self, $sql, @bind_values) = @_;
-    
-    # Connect if not
-    $self->connect unless $self->connected;
-    
-    # Do
-    my $ret_val = eval{$self->dbh->do($sql, @bind_values)};
-    
-    # Error
-    if ($@) {
-        my $error = $@;
-        require Data::Dumper;
-        
-        my $bind_value_dump
-          = Data::Dumper->Dump([\@bind_values], ['*bind_valuds']);
-        
-        croak("$error<Your SQL>\n$sql\n<Your bind values>\n$bind_value_dump\n");
-    }
-}
-
-# Create query
-sub create_query {
-    my ($self, $template) = @_;
-    my $class = ref $self;
-    
-    # Create query from SQL template
-    my $sql_template = $self->sql_template;
-    
-    # Try to get cached query
-    my $query = $class->_query_caches->{$template};
-    
-    # Create query
-    unless ($query) {
-        $query = eval{$sql_template->create_query($template)};
-        croak($@) if $@;
-        
-        $query = DBIx::Custom::Query->new($query);
-        
-        $class->_add_query_cache($template, $query);
-    }
-    
-    # Connect if not
-    $self->connect unless $self->connected;
-    
-    # Prepare statement handle
-    my $sth = $self->prepare($query->{sql});
-    
-    # Set statement handle
-    $query->sth($sth);
-    
-    # Set bind filter
-    $query->bind_filter($self->bind_filter);
-    
-    # Set no filter keys when binding
-    $query->no_bind_filters($self->no_bind_filters);
-    
-    # Set fetch filter
-    $query->fetch_filter($self->fetch_filter);
-    
-    # Set no filter keys when fetching
-    $query->no_fetch_filters($self->no_fetch_filters);
-    
-    return $query;
-}
-
-# Execute query
-sub execute {
-    my ($self, $query, $params)  = @_;
-    $params ||= {};
-    
-    # First argument is SQL template
-    if (!ref $query) {
-        my $template = $query;
-        $query = $self->create_query($template);
-        my $query_edit_cb = $_[3];
-        $query_edit_cb->($query) if ref $query_edit_cb eq 'CODE';
-    }
-    
-    # Create bind value
-    my $bind_values = $self->_build_bind_values($query, $params);
-    
-    # Execute
-    my $sth = $query->sth;
-    my $ret_val = eval{$sth->execute(@$bind_values)};
-    
-    # Execute error
-    if (my $execute_error = $@) {
-        require Data::Dumper;
-        my $sql              = $query->{sql} || '';
-        my $key_infos_dump   = Data::Dumper->Dump([$query->key_infos], ['*key_infos']);
-        my $params_dump      = Data::Dumper->Dump([$params], ['*params']);
-        
-        croak("$execute_error" . 
-              "<Your SQL>\n$sql\n" . 
-              "<Your parameters>\n$params_dump");
-    }
-    
-    # Return resultset if select statement is executed
-    if ($sth->{NUM_OF_FIELDS}) {
-        
-        # Get result class
-        my $result_class = $self->result_class;
-        
-        # Create result
-        my $result = $result_class->new({
-            sth              => $sth,
-            fetch_filter     => $query->fetch_filter,
-            no_fetch_filters => $query->no_fetch_filters
-        });
-        return $result;
-    }
-    return $ret_val;
-}
-
-# Build binding values
-sub _build_bind_values {
-    my ($self, $query, $params) = @_;
-    my $key_infos           = $query->key_infos;
-    my $bind_filter         = $query->bind_filter;
-    my $no_bind_filters_map = $query->_no_bind_filters_map || {};
-    
-    # binding values
-    my @bind_values;
-    
-    # Create bind values
-    KEY_INFOS :
-    foreach my $key_info (@$key_infos) {
-        # Set variable
-        my $access_keys  = $key_info->{access_keys};
-        my $original_key = $key_info->{original_key} || '';
-        my $table        = $key_info->{table}        || '';
-        my $column       = $key_info->{column}       || '';
-        
-        # Key is found?
-        my $found;
-        
-        # Build bind values
-        ACCESS_KEYS :
-        foreach my $access_key (@$access_keys) {
-            # Root parameter
-            my $root_params = $params;
-            
-            # Search corresponding value
-            for (my $i = 0; $i < @$access_key; $i++) {
-                # Current key
-                my $current_key = $access_key->[$i];
-                
-                # Last key
-                if ($i == @$access_key - 1) {
-                    # Key is array reference
-                    if (ref $current_key eq 'ARRAY') {
-                        # Filtering 
-                        if ($bind_filter &&
-                            !$no_bind_filters_map->{$original_key})
-                        {
-                            push @bind_values, 
-                                 $bind_filter->($root_params->[$current_key->[0]], 
-                                                $original_key,
-                                                $table, $column);
-                        }
-                        # Not filtering
-                        else {
-                            push @bind_values,
-                                 scalar $root_params->[$current_key->[0]];
-                        }
-                    }
-                    # Key is string
-                    else {
-                        # Key is not found
-                        next ACCESS_KEYS
-                          unless exists $root_params->{$current_key};
-                        
-                        # Filtering
-                        if ($bind_filter &&
-                            !$no_bind_filters_map->{$original_key}) 
-                        {
-                            push @bind_values,
-                                 $bind_filter->($root_params->{$current_key},
-                                                $original_key,
-                                                $table, $column);
-                        }
-                        # Not filtering
-                        else {
-                            push @bind_values,
-                                 scalar $root_params->{$current_key};
-                        }
-                    }
-                    
-                    # Key is found
-                    $found = 1;
-                    next KEY_INFOS;
-                }
-                # First or middle key
-                else {
-                    # Key is array reference
-                    if (ref $current_key eq 'ARRAY') {
-                        # Go next key
-                        $root_params = $root_params->[$current_key->[0]];
-                    }
-                    # Key is string
-                    else {
-                        # Not found
-                        next ACCESS_KEYS
-                          unless exists $root_params->{$current_key};
-                        
-                        # Go next key
-                        $root_params = $root_params->{$current_key};
-                    }
-                }
-            }
-        }
-        
-        # Key is not found
-        unless ($found) {
-            require Data::Dumper;
-            my $key_info_dump  = Data::Dumper->Dump([$key_info], ['*key_info']);
-            my $params_dump    = Data::Dumper->Dump([$params], ['*params']);
-            croak("Corresponding key is not found in your parameters\n" . 
-                  "<Key information>\n$key_info_dump\n\n" .
-                  "<Your parameters>\n$params_dump\n");
-        }
-    }
-    return \@bind_values;
-}
-
-# Run transaction
-sub run_transaction {
-    my ($self, $transaction) = @_;
-    
-    # Check auto commit
-    croak("AutoCommit must be true before transaction start")
-      unless $self->_auto_commit;
-    
-    # Auto commit off
-    $self->_auto_commit(0);
-    
-    # Run transaction
-    eval {$transaction->()};
-    
-    # Tranzaction error
-    my $transaction_error = $@;
-    
-    # Tranzaction is failed.
-    if ($transaction_error) {
-        # Rollback
-        eval{$self->dbh->rollback};
-        
-        # Rollback error
-        my $rollback_error = $@;
-        
-        # Auto commit on
-        $self->_auto_commit(1);
-        
-        if ($rollback_error) {
-            # Rollback is failed
-            croak("${transaction_error}Rollback is failed : $rollback_error");
-        }
-        else {
-            # Rollback is success
-            croak("${transaction_error}Rollback is success");
-        }
-    }
-    # Tranzaction is success
-    else {
-        # Commit
-        eval{$self->dbh->commit};
-        my $commit_error = $@;
-        
-        # Auto commit on
-        $self->_auto_commit(1);
-        
-        # Commit is failed
-        croak($commit_error) if $commit_error;
-    }
-}
-
-# Get last insert id
-sub last_insert_id {
-    my $self = shift;
-    
-    # Not connected
-    croak("Not yet connect to database")
-      unless $self->connected;
-    
-    return $self->dbh->last_insert_id(@_);
-}
-
-# Insert
-sub insert {
-    my ($self, $table, $insert_params, $query_edit_cb) = @_;
-    $table         ||= '';
-    $insert_params ||= {};
-    
-    # Insert keys
-    my @insert_keys = keys %$insert_params;
-    
-    # Not exists insert keys
-    croak("Key-value pairs for insert must be specified to 'insert' second argument")
-      unless @insert_keys;
-    
-    # Templte for insert
-    my $template = "insert into $table {insert " . join(' ', @insert_keys) . '}';
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit callback must be code reference
-    croak("Query edit callback must be code reference")
-      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
-    
-    # Query edit if need
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Execute query
-    my $ret_val = $self->execute($query, $insert_params);
-    
-    return $ret_val;
-}
-
-# Update
-sub update {
-    my ($self, $table, $update_params,
-        $where_params, $query_edit_cb, $options) = @_;
-    
-    $table         ||= '';
-    $update_params ||= {};
-    $where_params  ||= {};
-    
-    # Update keys
-    my @update_keys = keys %$update_params;
-    
-    # Not exists update kyes
-    croak("Key-value pairs for update must be specified to 'update' second argument")
-      unless @update_keys;
-    
-    # Where keys
-    my @where_keys = keys %$where_params;
-    
-    # Not exists where keys
-    croak("Key-value pairs for where clause must be specified to 'update' third argument")
-      if !@where_keys && !$options->{allow_update_all};
-    
-    # Update clause
-    my $update_clause = '{update ' . join(' ', @update_keys) . '}';
-    
-    # Where clause
-    my $where_clause = '';
-    if (@where_keys) {
-        $where_clause = 'where ';
-        foreach my $where_key (@where_keys) {
-            $where_clause .= "{= $where_key} and ";
-        }
-        $where_clause =~ s/ and $//;
-    }
-    
-    # Template for update
-    my $template = "update $table $update_clause $where_clause";
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit callback must be code reference
-    croak("Query edit callback must be code reference")
-      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
-    
-    # Query edit if need
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Rearrange parammeters
-    my $params = {'#update' => $update_params, %$where_params};
-    
-    # Execute query
-    my $ret_val = $self->execute($query, $params);
-    
-    return $ret_val;
-}
-
-# Update all rows
-sub update_all {
-    my ($self, $table, $update_params, $query_edit_cb) = @_;
-    
-    return $self->update($table, $update_params, {}, $query_edit_cb,
-                         {allow_update_all => 1});
-}
-
-# Delete
-sub delete {
-    my ($self, $table, $where_params, $query_edit_cb, $options) = @_;
-    $table        ||= '';
-    $where_params ||= {};
-    
-    # Where keys
-    my @where_keys = keys %$where_params;
-    
-    # Not exists where keys
-    croak("Key-value pairs for where clause must be specified to 'delete' second argument")
-      if !@where_keys && !$options->{allow_delete_all};
-    
-    # Where clause
-    my $where_clause = '';
-    if (@where_keys) {
-        $where_clause = 'where ';
-        foreach my $where_key (@where_keys) {
-            $where_clause .= "{= $where_key} and ";
-        }
-        $where_clause =~ s/ and $//;
-    }
-    
-    # Template for delete
-    my $template = "delete from $table $where_clause";
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit callback must be code reference
-    croak("Query edit callback must be code reference")
-      if $query_edit_cb && ref $query_edit_cb ne 'CODE';
-    
-    # Query edit if need
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Execute query
-    my $ret_val = $self->execute($query, $where_params);
-    
-    return $ret_val;
-}
-
-# Delete all rows
-sub delete_all {
-    my ($self, $table) = @_;
-    return $self->delete($table, {}, undef, {allow_delete_all => 1});
-}
-
-sub _select_usage { return << 'EOS' }
-Your select arguments is wrong.
-select usage:
-$dbi->select(
-    $table,                # must be string or array ref
-    [@$columns],           # must be array reference. this is optional
-    {%$where_params},      # must be hash reference.  this is optional
-    $append_statement,     # must be string.          this is optional
-    $query_edit_callback   # must be code reference.  this is optional
-);
-EOS
-
-sub select {
-    my $self = shift;
-    
-    # Check argument
-    croak($self->_select_usage) unless @_;
-    
-    # Arguments
-    my $tables = shift || '';
-    $tables    = [$tables] unless ref $tables;
-    
-    my $columns          = ref $_[0] eq 'ARRAY' ? shift : [];
-    my $where_params     = ref $_[0] eq 'HASH'  ? shift : {};
-    my $append_statement = $_[0] && !ref $_[0]  ? shift : '';
-    my $query_edit_cb    = shift if ref $_[0] eq 'CODE';
-    
-    # Check rest argument
-    croak($self->_select_usage) if @_;
-    
-    # SQL template for select statement
-    my $template = 'select ';
-    
-    # Join column clause
-    if (@$columns) {
-        foreach my $column (@$columns) {
-            $template .= "$column, ";
-        }
-        $template =~ s/, $/ /;
-    }
-    else {
-        $template .= '* ';
-    }
-    
-    # Join table
-    $template .= 'from ';
-    foreach my $table (@$tables) {
-        $template .= "$table, ";
-    }
-    $template =~ s/, $/ /;
-    
-    # Where clause keys
-    my @where_keys = keys %$where_params;
-    
-    # Join where clause
-    if (@where_keys) {
-        $template .= 'where ';
-        foreach my $where_key (@where_keys) {
-            $template .= "{= $where_key} and ";
-        }
-    }
-    $template =~ s/ and $//;
-    
-    # Append something to last of statement
-    if ($append_statement =~ s/^where //) {
-        if (@where_keys) {
-            $template .= " and $append_statement";
-        }
-        else {
-            $template .= " where $append_statement";
-        }
-    }
-    else {
-        $template .= " $append_statement";
-    }
-    
-    # Create query
-    my $query = $self->create_query($template);
-    
-    # Query edit
-    $query_edit_cb->($query) if $query_edit_cb;
-    
-    # Execute query
-    my $result = $self->execute($query, $where_params);
-    
-    return $result;
-}
-
-sub _query_caches     : ClassAttr { type => 'hash',
-                                    auto_build => sub {shift->_query_caches({}) } }
-                                    
-sub _query_cache_keys : ClassAttr { type => 'array',
-                                    auto_build => sub {shift->_query_cache_keys([])} }
-                                    
-sub query_cache_max   : ClassAttr { auto_build => sub {shift->query_cache_max(50)} }
-
-# Add query cahce
-sub _add_query_cache {
-    my ($class, $template, $query) = @_;
-    my $query_cache_keys = $class->_query_cache_keys;
-    my $query_caches     = $class->_query_caches;
-    
-    return $class if $query_caches->{$template};
-    
-    $query_caches->{$template} = $query;
-    push @$query_cache_keys, $template;
-    
-    my $overflow = @$query_cache_keys - $class->query_cache_max;
-    
-    for (my $i = 0; $i < $overflow; $i++) {
-        my $template = shift @$query_cache_keys;
-        delete $query_caches->{$template};
-    }
-    
-    return $class;
-}
-
-# Both bind_filter and fetch_filter off
-sub filter_off {
-    my $self = shift;
-    
-    # filter off
-    $self->bind_filter(undef);
-    $self->fetch_filter(undef);
-    
-    return $self;
-}
-
-Object::Simple->build_class;
-
-=head1 NAME
-
-DBIx::Custom - Customizable simple DBI
-
-=head1 VERSION
-
-Version 0.0401
-
-=head1 CAUTION
-
-This module is now experimental stage.
-
-I want you to try this module
-because I want this module stable, and not to damage your DB data by this module bug.
-
-Please tell me bug if you find
-
-=head1 SYNOPSIS
-
-  my $dbi = DBIx::Custom->new;
-  
-  my $query = $dbi->create_query($template);
-  $dbi->execute($query);
-
-=head1 CLASS-OBJECT ACCESSORS
-
-=head2 user
-
-    # Set and get database user name
-    $self = $dbi->user($user);
-    $user = $dbi->user;
-    
-    # Sample
-    $dbi->user('taro');
-
-=head2 password
-
-    # Set and get database password
-    $self     = $dbi->password($password);
-    $password = $dbi->password;
-    
-    # Sample
-    $dbi->password('lkj&le`@s');
-
-=head2 data_source
-
-    # Set and get database data source
-    $self        = $dbi->data_source($data_soruce);
-    $data_source = $dbi->data_source;
-    
-    # Sample(SQLite)
-    $dbi->data_source(dbi:SQLite:dbname=$database);
-    
-    # Sample(MySQL);
-    $dbi->data_source("dbi:mysql:dbname=$database");
-    
-    # Sample(PostgreSQL)
-    $dbi->data_source("dbi:Pg:dbname=$database");
-    
-=head2 database
-
-    # Set and get database name
-    $self     = $dbi->database($database);
-    $database = $dbi->database;
-
-This method will be used in subclass connect method.
-
-=head2 dbi_options
-
-    # Set and get DBI option
-    $self       = $dbi->dbi_options({$options => $value, ...});
-    $dbi_options = $dbi->dbi_options;
-
-    # Sample
-    $dbi->dbi_options({PrintError => 0, RaiseError => 1});
-
-dbi_options is used when you connect database by using connect.
-
-=head2 prepare
-
-    $sth = $dbi->prepare($sql);
-
-This method is same as DBI::prepare
-
-=head2 do
-
-    $dbi->do($sql, @bind_values);
-
-This method is same as DBI::do
-
-=head2 sql_template
-
-    # Set and get SQL::Template object
-    $self         = $dbi->sql_template($sql_template);
-    $sql_template = $dbi->sql_template;
-    
-    # Sample
-    $dbi->sql_template(DBI::Cutom::SQL::Template->new);
-
-=head2 filters
-
-    # Set and get filters
-    $self    = $dbi->filters($filters);
-    $filters = $dbi->filters;
-
-=head2 formats
-
-    # Set and get formats
-    $self    = $dbi->formats($formats);
-    $formats = $dbi->formats;
-    
-=head2 bind_filter
-
-    # Set and get binding filter
-    $self        = $dbi->bind_filter($bind_filter);
-    $bind_filter = $dbi->bind_filter
-
-    # Sample
-    $dbi->bind_filter($self->filters->{default_bind_filter});
-    
-
-you can get DBI database handle if you need.
-
-=head2 fetch_filter
-
-    # Set and get Fetch filter
-    $self         = $dbi->fetch_filter($fetch_filter);
-    $fetch_filter = $dbi->fetch_filter;
-
-    # Sample
-    $dbi->fetch_filter($self->filters->{default_fetch_filter});
-
-=head2 no_bind_filters
-
-    # Set and get no filter keys when binding
-    $self            = $dbi->no_bind_filters($no_bind_filters);
-    $no_bind_filters = $dbi->no_bind_filters;
-
-=head2 no_fetch_filters
-
-    # Set and get no filter keys when fetching
-    $self             = $dbi->no_fetch_filters($no_fetch_filters);
-    $no_fetch_filters = $dbi->no_fetch_filters;
-
-=head2 result_class
-
-    # Set and get resultset class
-    $self         = $dbi->result_class($result_class);
-    $result_class = $dbi->result_class;
-    
-    # Sample
-    $dbi->result_class('DBIx::Custom::Result');
-
-=head2 dbh
-
-    # Get database handle
-    $dbh = $self->dbh;
-
-=head1 METHODS
-
-=head2 connect
-
-    # Connect to database
-    $self = $dbi->connect;
-    
-    # Sample
-    $dbi = DBIx::Custom->new(user => 'taro', password => 'lji8(', 
-                            data_soruce => "dbi:mysql:dbname=$database");
-    $dbi->connect;
-
-=head2 disconnect
-
-    # Disconnect database
-    $dbi->disconnect;
-
-If database is already disconnected, this method do noting.
-
-=head2 reconnect
-
-    # Reconnect
-    $dbi->reconnect;
-
-=head2 connected
-
-    # Check connected
-    $dbi->connected
-    
-=head2 filter_off
-
-    # bind_filter and fitch_filter off
-    $self->filter_off;
-    
-This is equeal to
-    
-    $self->bind_filter(undef);
-    $self->fetch_filter(undef);
-
-=head2 add_filter
-
-    # Add filter (hash ref or hash can be recieve)
-    $self = $dbi->add_filter({$filter_name => $filter, ...});
-    $self = $dbi->add_filter($filetr_name => $filter, ...);
-    
-    # Sample
-    $dbi->add_filter(
-        decode_utf8 => sub {
-            my ($key, $value, $table, $column) = @_;
-            return Encode::decode('UTF-8', $value);
-        },
-        datetime_to_string => sub {
-            my ($key, $value, $table, $column) = @_;
-            return $value->strftime('%Y-%m-%d %H:%M:%S')
-        },
-        default_bind_filter => sub {
-            my ($key, $value, $table, $column) = @_;
-            if (ref $value eq 'Time::Piece') {
-                return $dbi->filters->{datetime_to_string}->($value);
-            }
-            else {
-                return $dbi->filters->{decode_utf8}->($value);
-            }
-        },
-        
-        encode_utf8 => sub {
-            my ($key, $value) = @_;
-            return Encode::encode('UTF-8', $value);
-        },
-        string_to_datetime => sub {
-            my ($key, $value) = @_;
-            return DateTime::Format::MySQL->parse_datetime($value);
-        },
-        default_fetch_filter => sub {
-            my ($key, $value, $type, $sth, $i) = @_;
-            if ($type eq 'DATETIME') {
-                return $dbi->filters->{string_to_datetime}->($value);
-            }
-            else {
-                return $dbi->filters->{encode_utf8}->($value);
-            }
-        }
-    );
-
-add_filter add filter to filters
-
-=head2 add_format
-
-    $dbi->add_format(date => '%Y:%m:%d');
-
-=head2 create_query
-    
-    # Create Query object from SQL template
-    my $query = $dbi->create_query($template);
-    
-=head2 execute
-
-    # Parse SQL template and execute SQL
-    $result = $dbi->query($query, $params);
-    $result = $dbi->query($template, $params); # Shorcut
-    
-    # Sample
-    $result = $dbi->query("select * from authors where {= name} and {= age}", 
-                          {author => 'taro', age => 19});
-    
-    while (my @row = $result->fetch) {
-        # do something
-    }
-
-See also L<DBIx::Custom::SQL::Template>
-
-=head2 run_transaction
-
-    # Run transaction
-    $dbi->run_transaction(sub {
-        # do something
-    });
-
-If transaction is success, commit is execute. 
-If tranzation is died, rollback is execute.
-
-=head2 insert
-
-    # Insert
-    $dbi->insert($table, $insert_values);
-    
-    # Sample
-    $dbi->insert('books', {title => 'Perl', author => 'Taro'});
-
-=head2 update
-
-    # Update
-    $dbi->update($table, $update_values, $where);
-    
-    # Sample
-    $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
-
-=head2 update_all
-
-    # Update all rows
-    $dbi->update($table, $updat_values);
-
-=head2 delete
-
-    # Delete
-    $dbi->delete($table, $where);
-    
-    # Sample
-    $dbi->delete('Books', {id => 5});
-
-=head2 delete_all
-
-    # Delete all rows
-    $dbi->delete_all($table);
-
-=head2 last_insert_id
-
-    # Get last insert id
-    $last_insert_id = $dbi->last_insert_id;
-    
-This method is same as DBI last_insert_id;
-
-=head2 select
-    
-    # Select
-    $dbi->select(
-        $table,                # must be string or array;
-        [@$columns],           # must be array reference. this is optional
-        {%$where_params},      # must be hash reference.  this is optional
-        $append_statement,     # must be string.          this is optional
-        $query_edit_callback   # must be code reference.  this is optional
-    );
-    
-    # Sample
-    $dbi->select(
-        'Books',
-        ['title', 'author'],
-        {id => 1},
-        "for update",
-        sub {
-            my $query = shift;
-            $query->bind_filter(sub {
-                # ...
-            });
-        }
-    );
-    
-    # The way to join multi tables
-    $dbi->select(
-        ['table1', 'table2'],
-        ['table1.id as table1_id', 'title'],
-        {table1.id => 1},
-        "where table1.id = table2.id",
-    );
-
-=head1 Class Accessors
-
-=head2 query_cache_max
-
-    # Max query cache count
-    $class           = $class->query_cache_max($query_cache_max);
-    $query_cache_max = $class->query_cache_max;
-    
-    # Sample
-    DBIx::Custom->query_cache_max(50);
-
-=head1 CAUTION
-
-DBIx::Custom have DIB object internal.
-This module is work well in the following DBI condition.
-
-    1. AutoCommit is true
-    2. RaiseError is true
-
-By default, Both AutoCommit and RaiseError is true.
-You must not change these mode not to damage your data.
-
-If you change these mode, 
-you cannot get correct error message, 
-or run_transaction may fail.
-
-=head1 AUTHOR
-
-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
-
-Github L<http://github.com/yuki-kimoto>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2009 Yuki Kimoto, all rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut

-9

DBIx-Custom/t/00-load.t

View

@@ -1,9 +0,0 @@
-#!perl -T
-
-use Test::More tests => 1;
-
-BEGIN {
-	use_ok( 'DBIx::Custom' );
-}
-
-diag( "Testing DBIx::Custom $DBIx::Custom::VERSION, Perl $], $^X" );

-220

DBIx-Custom/t/01-core.t

View

@@ -1,220 +0,0 @@
-use Test::More 'no_plan';
-use strict;
-use warnings;
-
-use DBIx::Custom;
-use DBIx::Custom::SQL::Template;
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Variables for test
-our $SQL_TMPL = {
-    0 => DBIx::Custom::SQL::Template->new->tag_start(0),
-    1 => DBIx::Custom::SQL::Template->new->tag_start(1),
-    2 => DBIx::Custom::SQL::Template->new->tag_start(2)
-};
-my $dbi;
-
-
-test 'Constructor';
-$dbi = DBIx::Custom->new(
-    user => 'a',
-    database => 'a',
-    password => 'b',
-    data_source => 'c',
-    dbi_options => {d => 1, e => 2},
-    filters => {
-        f => 3,
-    },
-    bind_filter => 'f',
-    fetch_filter => 'g',
-    result_class => 'g',
-    sql_template => $SQL_TMPL->{0},
-);
-is_deeply($dbi,{user => 'a', database => 'a', password => 'b', data_source => 'c', 
-                dbi_options => {d => 1, e => 2}, filters => {f => 3}, bind_filter => 'f',
-                fetch_filter => 'g', result_class => 'g',
-                sql_template => $SQL_TMPL->{0}}, $test);
-isa_ok($dbi, 'DBIx::Custom');
-
-
-test 'Sub class constructor';
-{
-    package DBIx::Custom::T1;
-    use base 'DBIx::Custom';
-    
-    __PACKAGE__
-      ->user('a')
-      ->database('a')
-      ->password('b')
-      ->data_source('c')
-      ->dbi_options({d => 1, e => 2})
-      ->filters(
-          f => 3
-      )
-      ->formats(
-          f => 3
-      )
-      ->bind_filter('f')
-      ->fetch_filter('g')
-      ->result_class('DBIx::Custom::Result')
-      ->sql_template($SQL_TMPL->{0})
-    ;
-}
-$dbi = DBIx::Custom::T1->new(
-    user => 'ao',
-    database => 'ao',
-    password => 'bo',
-    data_source => 'co',
-    dbi_options => {do => 10, eo => 20},
-    filters => {
-        fo => 30,
-    },
-    formats => {
-        fo => 30,
-    },
-    bind_filter => 'fo',
-    fetch_filter => 'go',
-    result_class => 'ho',
-    sql_template => $SQL_TMPL->{0},
-);
-is($dbi->user, 'ao', "$test : user");
-is($dbi->database, 'ao', "$test : database");
-is($dbi->password, 'bo', "$test : passowr");
-is($dbi->data_source, 'co', "$test : data_source");
-is_deeply($dbi->dbi_options, {do => 10, eo => 20}, "$test : dbi_options");
-is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
-is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
-is($dbi->bind_filter, 'fo', "$test : bind_filter");
-is($dbi->fetch_filter, 'go', "$test : fetch_filter");
-is($dbi->result_class, 'ho', "$test : result_class");
-is($dbi->sql_template->tag_start, 0, "$test : sql_template");
-isa_ok($dbi, 'DBIx::Custom::T1');
-
-test 'Sub class constructor default';
-$dbi = DBIx::Custom::T1->new;
-is($dbi->user, 'a', "$test : user");
-is($dbi->database, 'a', "$test : database");
-is($dbi->password, 'b', "$test : password");
-is($dbi->data_source, 'c', "$test : data_source");
-is_deeply($dbi->dbi_options, {d => 1, e => 2}, "$test : dbi_options");
-is_deeply({$dbi->filters}, {f => 3}, "$test : filters");
-is_deeply({$dbi->formats}, {f => 3}, "$test : formats");
-is($dbi->bind_filter, 'f', "$test : bind_filter");
-is($dbi->fetch_filter, 'g', "$test : fetch_filter");
-is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");
-is($dbi->sql_template->tag_start, 0, "$test : sql_template");
-isa_ok($dbi, 'DBIx::Custom::T1');
-
-
-test 'Sub sub class constructor default';
-{
-    package DBIx::Custom::T1_2;
-    use base 'DBIx::Custom::T1';
-}
-$dbi = DBIx::Custom::T1_2->new;
-is($dbi->user, 'a', "$test : user");
-is($dbi->database, 'a', "$test : database");
-is($dbi->password, 'b', "$test : passowrd");
-is($dbi->data_source, 'c', "$test : data_source");
-is_deeply($dbi->dbi_options, {d => 1, e => 2}, "$test : dbi_options");
-is_deeply(scalar $dbi->filters, {f => 3}, "$test : filters");
-is_deeply(scalar $dbi->formats, {f => 3}, "$test : formats");
-is($dbi->bind_filter, 'f', "$test : bind_filter");
-is($dbi->fetch_filter, 'g', "$test : fetch_filter");
-is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");
-is($dbi->sql_template->tag_start, 0, "$test sql_template");
-isa_ok($dbi, 'DBIx::Custom::T1_2');
-
-
-test 'Customized sub class constructor default';
-{
-    package DBIx::Custom::T1_3;
-    use base 'DBIx::Custom::T1';
-    
-    __PACKAGE__
-      ->user('ao')
-      ->database('ao')
-      ->password('bo')
-      ->data_source('co')
-      ->dbi_options({do => 10, eo => 20})
-      ->filters(
-        fo => 30
-      )
-      ->formats(
-        fo => 30
-      )
-      ->bind_filter('fo')
-      ->fetch_filter('go')
-      ->result_class('ho')
-      ->sql_template($SQL_TMPL->{1})
-    ;
-}
-$dbi = DBIx::Custom::T1_3->new;
-is($dbi->user, 'ao', "$test : user");
-is($dbi->database, 'ao', "$test : database");
-is($dbi->password, 'bo', "$test : password");
-is($dbi->data_source, 'co', "$test : data_source");
-is_deeply($dbi->dbi_options, {do => 10, eo => 20}, "$test : dbi_options");
-is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
-is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
-is($dbi->bind_filter, 'fo', "$test : bind_filter");
-is($dbi->fetch_filter, 'go', "$test : fetch_filter");
-is($dbi->result_class, 'ho', "$test : result_class");
-is($dbi->sql_template->tag_start, 1, "$test : sql_template");
-isa_ok($dbi, 'DBIx::Custom::T1_3');
-
-
-test 'Customized sub class constructor';
-$dbi = DBIx::Custom::T1_3->new(
-    user => 'a',
-    database => 'a',
-    password => 'b',
-    data_source => 'c',
-    dbi_options => {d => 1, e => 2},
-    filters => {
-        f => 3,
-    },
-    formats => {
-        f => 3,
-    },
-    bind_filter => 'f',
-    fetch_filter => 'g',
-    result_class => 'h',
-    sql_template => $SQL_TMPL->{2},
-);
-is($dbi->user, 'a', "$test : user");
-is($dbi->database, 'a', "$test : database");
-is($dbi->password, 'b', "$test : password");
-is($dbi->data_source, 'c', "$test : data_source");
-is_deeply($dbi->dbi_options, {d => 1, e => 2}, "$test : dbi_options");
-is_deeply({$dbi->filters}, {f => 3}, "$test : filters");
-is_deeply({$dbi->formats}, {f => 3}, "$test : formats");
-is($dbi->bind_filter, 'f', "$test : bind_filter");
-is($dbi->fetch_filter, 'g', "$test : fetch_filter");
-is($dbi->result_class, 'h', "$test : result_class");
-is($dbi->sql_template->tag_start, 2, "$test : sql_template");
-isa_ok($dbi, 'DBIx::Custom');
-
-
-test 'add_filters';
-$dbi = DBIx::Custom->new;
-$dbi->add_filter(a => sub {1});
-is($dbi->filters->{a}->(), 1, $test);
-
-test 'add_formats';
-$dbi = DBIx::Custom->new;
-$dbi->add_format(a => sub {1});
-is($dbi->formats->{a}->(), 1, $test);
-
-test 'filter_off';
-$dbi = DBIx::Custom->new;
-$dbi->bind_filter('a');
-$dbi->fetch_filter('b');
-$dbi->filter_off;
-ok(!$dbi->bind_filter,  "$test : bind_filter  off");
-ok(!$dbi->fetch_filter, "$test : fetch_filter off");

-716

DBIx-Custom/t/02-sqlite.t

View

@@ -1,716 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-BEGIN {
-    eval { require DBD::SQLite; 1 }
-        or plan skip_all => 'DBD::SQLite required';
-    eval { DBD::SQLite->VERSION >= 1 }
-        or plan skip_all => 'DBD::SQLite >= 1.00 required';
-
-    plan 'no_plan';
-    use_ok('DBIx::Custom');
-}
-
-# Function for test name
-my $test;
-sub test {
-    $test = shift;
-}
-
-# Constant varialbes for test
-my $CREATE_TABLE = {
-    0 => 'create table table1 (key1 char(255), key2 char(255));',
-    1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
-    2 => 'create table table2 (key1 char(255), key3 char(255));'
-};
-
-my $SELECT_TMPL = {
-    0 => 'select * from table1;'
-};
-
-my $DROP_TABLE = {
-    0 => 'drop table table1'
-};
-
-my $NEW_ARGS = {
-    0 => {data_source => 'dbi:SQLite:dbname=:memory:'}
-};
-
-# Variables for test
-my $dbi;
-my $sth;
-my $tmpl;
-my @tmpls;
-my $select_tmpl;
-my $insert_tmpl;
-my $update_tmpl;
-my $params;
-my $sql;
-my $result;
-my @rows;
-my $rows;
-my $query;
-my @queries;
-my $select_query;
-my $insert_query;
-my $update_query;
-my $ret_val;
-
-
-test 'disconnect';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->connect;
-$dbi->disconnect;
-ok(!$dbi->dbh, $test);
-
-
-test 'connected';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-ok(!$dbi->connected, "$test : not connected");
-$dbi->connect;
-ok($dbi->connected, "$test : connected");
-
-
-test 'preapare';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$sth = $dbi->prepare($CREATE_TABLE->{0});
-ok($sth, "$test : auto connect");
-$sth->execute;
-$sth = $dbi->prepare($DROP_TABLE->{0});
-ok($sth, "$test : basic");
-
-
-test 'do';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$ret_val = $dbi->do($CREATE_TABLE->{0});
-ok(defined $ret_val, "$test : auto connect");
-$ret_val = $dbi->do($DROP_TABLE->{0});
-ok(defined $ret_val, "$test : basic");
-
-
-# Prepare table
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->connect;
-$dbi->do($CREATE_TABLE->{0});
-$sth = $dbi->prepare("insert into table1 (key1, key2) values (?, ?);");
-$sth->execute(1, 2);
-$sth->execute(3, 4);
-
-
-test 'DBIx::Custom::Result test';
-$tmpl = "select key1, key2 from table1";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query);
-
-@rows = ();
-while (my $row = $result->fetch) {
-    push @rows, [@$row];
-}
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch scalar context");
-
-$result = $dbi->execute($query);
-@rows = ();
-while (my @row = $result->fetch) {
-    push @rows, [@row];
-}
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch list context");
-
-$result = $dbi->execute($query);
-@rows = ();
-while (my $row = $result->fetch_hash) {
-    push @rows, {%$row};
-}
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : fetch_hash scalar context");
-
-$result = $dbi->execute($query);
-@rows = ();
-while (my %row = $result->fetch_hash) {
-    push @rows, {%row};
-}
-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : fetch hash list context");
-
-$result = $dbi->execute($query);
-$rows = $result->fetch_all;
-is_deeply($rows, [[1, 2], [3, 4]], "$test : fetch_all scalar context");
-
-$result = $dbi->execute($query);
-@rows = $result->fetch_all;
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch_all list context");
-
-$result = $dbi->execute($query);
-@rows = $result->fetch_hash_all;
-is_deeply($rows, [[1, 2], [3, 4]], "$test : fetch_hash_all scalar context");
-
-$result = $dbi->execute($query);
-@rows = $result->fetch_all;
-is_deeply(\@rows, [[1, 2], [3, 4]], "$test : fetch_hash_all list context");
-
-
-test 'Insert query return value';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$tmpl = "insert into table1 {insert key1 key2}";
-$query = $dbi->create_query($tmpl);
-$ret_val = $dbi->execute($query, {key1 => 1, key2 => 2});
-ok($ret_val, $test);
-
-
-test 'Direct execute';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$insert_tmpl = "insert into table1 {insert key1 key2}";
-$dbi->execute($insert_tmpl, {key1 => 1, key2 => 2}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        if ($key eq 'key2') {
-            return $value + 1;
-        }
-        return $value;
-    });
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 3}], $test);
-
-
-test 'Filter basic';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-
-$insert_tmpl  = "insert into table1 {insert key1 key2};";
-$insert_query = $dbi->create_query($insert_tmpl);
-$insert_query->bind_filter(sub {
-    my ($value, $key, $table, $column) = @_;
-    if ($key eq 'key1' && $table eq '' && $column eq 'key1') {
-        return $value * 2;
-    }
-    return $value;
-});
-$dbi->execute($insert_query, {key1 => 1, key2 => 2});
-$select_query = $dbi->create_query($SELECT_TMPL->{0});
-$select_query->fetch_filter(sub {
-    my ($value, $key, $type, $sth, $i) = @_;
-    if ($key eq 'key2' && $type =~ /char/ && $sth->can('execute') && $i == 1) {
-        return $value * 3;
-    }
-    return $value;
-});
-$result = $dbi->execute($select_query);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 2, key2 => 6}], "$test : bind_filter fetch_filter");
-
-$dbi->do("delete from table1;");
-$insert_query->no_bind_filters('key1');
-$select_query->no_fetch_filters('key2');
-$dbi->execute($insert_query, {key1 => 1, key2 => 2});
-$result = $dbi->execute($select_query);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : no_fetch_filters no_bind_filters");
-
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$insert_tmpl  = "insert into table1 {insert table1.key1 table1.key2}";
-$insert_query = $dbi->create_query($insert_tmpl);
-$insert_query->bind_filter(sub {
-    my ($value, $key, $table, $column) = @_;
-    if ($key eq 'table1.key1' && $table eq 'table1' && $column eq 'key1') {
-        return $value * 3;
-    }
-    return $value;
-});
-$dbi->execute($insert_query, {table1 => {key1 => 1, key2 => 2}});
-$select_query = $dbi->create_query($SELECT_TMPL->{0});
-$result       = $dbi->execute($select_query);
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 2}], "$test : insert with table name");
-
-test 'Filter in';
-$insert_tmpl  = "insert into table1 {insert key1 key2};";
-$insert_query = $dbi->create_query($insert_tmpl);
-$dbi->execute($insert_query, {key1 => 2, key2 => 4});
-$select_tmpl = "select * from table1 where {in table1.key1 2} and {in table1.key2 2}";
-$select_query = $dbi->create_query($select_tmpl);
-$select_query->bind_filter(sub {
-    my ($value, $key, $table, $column) = @_;
-    if ($key eq 'table1.key1' && $table eq 'table1' && $column eq 'key1' || $key eq 'table1.key2') {
-        return $value * 2;
-    }
-    return $value;
-});
-$result = $dbi->execute($select_query, {table1 => {key1 => [1,5], key2 => [2,5]}});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 2, key2 => 4}], "$test : bind_filter");
-
-
-test 'DBIx::Custom::SQL::Template basic tag';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{1});
-$sth = $dbi->prepare("insert into table1 (key1, key2, key3, key4, key5) values (?, ?, ?, ?, ?);");
-$sth->execute(1, 2, 3, 4, 5);
-$sth->execute(6, 7, 8, 9, 10);
-
-$tmpl = "select * from table1 where {= key1} and {<> key2} and {< key3} and {> key4} and {>= key5};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {key1 => 1, key2 => 3, key3 => 4, key4 => 3, key5 => 5});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag1");
-
-$tmpl = "select * from table1 where {= table1.key1} and {<> table1.key2} and {< table1.key3} and {> table1.key4} and {>= table1.key5};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {table1 => {key1 => 1, key2 => 3, key3 => 4, key4 => 3, key5 => 5}});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag1 with table");
-
-$tmpl = "select * from table1 where {= table1.key1} and {<> table1.key2} and {< table1.key3} and {> table1.key4} and {>= table1.key5};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {'table1.key1' => 1, 'table1.key2' => 3, 'table1.key3' => 4, 'table1.key4' => 3, 'table1.key5' => 5});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag1 with table dot");
-
-$tmpl = "select * from table1 where {<= key1} and {like key2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {key1 => 1, key2 => '%2%'});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag2");
-
-$tmpl = "select * from table1 where {<= table1.key1} and {like table1.key2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {table1 => {key1 => 1, key2 => '%2%'}});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag2 with table");
-
-$tmpl = "select * from table1 where {<= table1.key1} and {like table1.key2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {'table1.key1' => 1, 'table1.key2' => '%2%'});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic tag2 with table dot");
-
-
-test 'DIB::Custom::SQL::Template in tag';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{1});
-$sth = $dbi->prepare("insert into table1 (key1, key2, key3, key4, key5) values (?, ?, ?, ?, ?);");
-$sth->execute(1, 2, 3, 4, 5);
-$sth->execute(6, 7, 8, 9, 10);
-
-$tmpl = "select * from table1 where {in key1 2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {key1 => [9, 1]});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic");
-
-$tmpl = "select * from table1 where {in table1.key1 2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {table1 => {key1 => [9, 1]}});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table");
-
-$tmpl = "select * from table1 where {in table1.key1 2};";
-$query = $dbi->create_query($tmpl);
-$result = $dbi->execute($query, {'table1.key1' => [9, 1]});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table dot");
-
-
-test 'DBIx::Custom::SQL::Template insert tag';
-$dbi->do("delete from table1");
-$insert_tmpl = 'insert into table1 {insert key1 key2 key3 key4 key5}';
-$dbi->execute($insert_tmpl, {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : basic");
-
-$dbi->do("delete from table1");
-$dbi->execute($insert_tmpl, {'#insert' => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : #insert");
-
-$dbi->do("delete from table1");
-$insert_tmpl = 'insert into table1 {insert table1.key1 table1.key2 table1.key3 table1.key4 table1.key5}';
-$dbi->execute($insert_tmpl, {table1 => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table name");
-
-$dbi->do("delete from table1");
-$insert_tmpl = 'insert into table1 {insert table1.key1 table1.key2 table1.key3 table1.key4 table1.key5}';
-$dbi->execute($insert_tmpl, {'table1.key1' => 1, 'table1.key2' => 2, 'table1.key3' => 3, 'table1.key4' => 4, 'table1.key5' => 5});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : with table name dot");
-
-$dbi->do("delete from table1");
-$dbi->execute($insert_tmpl, {'#insert' => {table1 => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : #insert with table name");
-
-$dbi->do("delete from table1");
-$dbi->execute($insert_tmpl, {'#insert' => {'table1.key1' => 1, 'table1.key2' => 2, 'table1.key3' => 3, 'table1.key4' => 4, 'table1.key5' => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "$test : #insert with table name dot");
-
-
-test 'DBIx::Custom::SQL::Template update tag';
-$dbi->do("delete from table1");
-$insert_tmpl = "insert into table1 {insert key1 key2 key3 key4 key5}";
-$dbi->execute($insert_tmpl, {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->execute($insert_tmpl, {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-
-$update_tmpl = 'update table1 {update key1 key2 key3 key4} where {= key5}';
-$dbi->execute($update_tmpl, {key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5});
-
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : basic");
-
-$dbi->execute($update_tmpl, {'#update' => {key1 => 2, key2 => 2, key3 => 2, key4 => 2}, key5 => 5});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 2, key2 => 2, key3 => 2, key4 => 2, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : #update");
-
-$update_tmpl = 'update table1 {update table1.key1 table1.key2 table1.key3 table1.key4} where {= table1.key5}';
-$dbi->execute($update_tmpl, {table1 => {key1 => 3, key2 => 3, key3 => 3, key4 => 3, key5 => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 3, key3 => 3, key4 => 3, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : with table name");
-
-$update_tmpl = 'update table1 {update table1.key1 table1.key2 table1.key3 table1.key4} where {= table1.key5}';
-$dbi->execute($update_tmpl, {'table1.key1' => 4, 'table1.key2' => 4, 'table1.key3' => 4, 'table1.key4' => 4, 'table1.key5' => 5});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 4, key2 => 4, key3 => 4, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : with table name dot");
-
-$dbi->execute($update_tmpl, {'#update' => {table1 => {key1 => 5, key2 => 5, key3 => 5, key4 => 5}}, table1 => {key5 => 5}});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 5, key2 => 5, key3 => 5, key4 => 5, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : update tag #update with table name");
-
-$dbi->execute($update_tmpl, {'#update' => {'table1.key1' => 6, 'table1.key2' => 6, 'table1.key3' => 6, 'table1.key4' => 6}, 'table1.key5' => 5});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 6, key2 => 6, key3 => 6, key4 => 6, key5 => 5},
-                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "$test : update tag #update with table name dot");
-
-
-test 'run_tansaction';
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->run_transaction(sub {
-    $insert_tmpl = 'insert into table1 {insert key1 key2}';
-    $dbi->execute($insert_tmpl, {key1 => 1, key2 => 2});
-    $dbi->execute($insert_tmpl, {key1 => 3, key2 => 4});
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : commit");
-
-$dbi->do($DROP_TABLE->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->dbh->{RaiseError} = 0;
-eval{
-    $dbi->run_transaction(sub {
-        $insert_tmpl = 'insert into table1 {insert key1 key2}';
-        $dbi->execute($insert_tmpl, {key1 => 1, key2 => 2});
-        die "Fatal Error";
-        $dbi->execute($insert_tmpl, {key1 => 3, key2 => 4});
-    })
-};
-like($@, qr/Fatal Error.*Rollback is success/ms, "$test : Rollback success message");
-ok(!$dbi->dbh->{RaiseError}, "$test : restore RaiseError value");
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [], "$test : rollback");
-
-
-test 'Error case';
-$dbi = DBIx::Custom->new;
-eval{$dbi->run_transaction};
-like($@, qr/Not yet connect to database/, "$test : Yet Connected");
-
-$dbi = DBIx::Custom->new(data_source => 'dbi:SQLit');
-eval{$dbi->connect;};
-ok($@, "$test : connect error");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->connect;
-$dbi->dbh->{AutoCommit} = 0;
-eval{$dbi->run_transaction()};
-like($@, qr/AutoCommit must be true before transaction start/,
-         "$test : run_transaction auto commit is false");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$sql = 'laksjdf';
-eval{$dbi->prepare($sql)};
-like($@, qr/$sql/, "$test : prepare fail");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$sql = 'laksjdf';
-eval{$dbi->do($sql, qw/1 2 3/)};
-like($@, qr/$sql/, "$test : do fail");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-eval{$dbi->create_query("{p }")};
-ok($@, "$test : create_query invalid SQL template");
-
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$query = $dbi->create_query("select * from table1 where {= key1}");
-eval{$dbi->execute($query, {key2 => 1})};
-like($@, qr/Corresponding key is not found in your parameters/, 
-        "$test : execute corresponding key not found");
-
-
-test 'insert';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : basic");
-
-$dbi->do('delete from table1');
-$dbi->insert('table1', {key1 => 1, key2 => 2}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        if ($key eq 'key1') {
-            return $value * 3;
-        }
-        return $value;
-    });
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 2}], "$test : edit_query_callback");
-
-
-test 'insert error';
-eval{$dbi->insert('table1')};
-like($@, qr/Key-value pairs for insert must be specified to 'insert' second argument/, "$test : insert key-value not specifed");
-
-eval{$dbi->insert('table1', {key1 => 1, key2 => 2}, 'aaa')};
-like($@, qr/Query edit callback must be code reference/, "$test : query edit callback not code ref");
-
-
-test 'update';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{1});
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-$dbi->update('table1', {key2 => 11}, {key1 => 1});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 3, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
-                  "$test : basic");
-                  
-$dbi->do("delete from table1");
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-$dbi->update('table1', {key2 => 12}, {key2 => 2, key3 => 3});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 12, key3 => 3, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
-                  "$test : update key same as search key");
-
-$dbi->do("delete from table1");
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-$dbi->update('table1', {key2 => 11}, {key1 => 1}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        if ($key eq 'key2') {
-            return $value * 2;
-        }
-        return $value;
-    });
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 22, key3 => 3, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
-                  "$test : query edit callback");
-
-
-test 'update error';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{1});
-eval{$dbi->update('table1')};
-like($@, qr/Key-value pairs for update must be specified to 'update' second argument/,
-         "$test : update key-value pairs not specified");
-
-eval{$dbi->update('table1', {key2 => 1})};
-like($@, qr/Key-value pairs for where clause must be specified to 'update' third argument/,
-         "$test : where key-value pairs not specified");
-
-eval{$dbi->update('table1', {key2 => 1}, {key2 => 3}, 'aaa')};
-like($@, qr/Query edit callback must be code reference/, 
-         "$test : query edit callback not code reference");
-
-
-test 'update_all';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{1});
-$dbi->insert('table1', {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
-$dbi->insert('table1', {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
-$dbi->update_all('table1', {key2 => 10}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        return $value * 2;
-    })
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 20, key3 => 3, key4 => 4, key5 => 5},
-                  {key1 => 6, key2 => 20, key3 => 8, key4 => 9, key5 => 10}],
-                  "$test : query edit callback");
-
-
-test 'delete';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$dbi->delete('table1', {key1 => 1});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : basic");
-
-$dbi->do("delete from table1;");
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$dbi->delete('table1', {key2 => 1}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        return $value * 2;
-    });
-});
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : query edit callback");
-
-$dbi->delete_all('table1');
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$dbi->delete('table1', {key1 => 1, key2 => 2});
-$rows = $dbi->select('table1')->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : delete multi key");
-
-
-test 'delete error';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-eval{$dbi->delete('table1')};
-like($@, qr/Key-value pairs for where clause must be specified to 'delete' second argument/,
-         "$test : where key-value pairs not specified");
-
-eval{$dbi->delete('table1', {key1 => 1}, 'aaa')};
-like($@, qr/Query edit callback must be code reference/, 
-         "$test : query edit callback not code ref");
-
-
-test 'delete_all';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$dbi->delete_all('table1');
-$result = $dbi->execute($SELECT_TMPL->{0});
-$rows   = $result->fetch_hash_all;
-is_deeply($rows, [], "$test : basic");
-
-
-test 'select';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-$dbi->do($CREATE_TABLE->{0});
-$dbi->insert('table1', {key1 => 1, key2 => 2});
-$dbi->insert('table1', {key1 => 3, key2 => 4});
-$rows = $dbi->select('table1')->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2},
-                  {key1 => 3, key2 => 4}], "$test : table");
-
-$rows = $dbi->select('table1', ['key1'])->fetch_hash_all;
-is_deeply($rows, [{key1 => 1}, {key1 => 3}], "$test : table and columns and where key");
-
-$rows = $dbi->select('table1', {key1 => 1})->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : table and columns and where key");
-
-$rows = $dbi->select('table1', ['key1'], {key1 => 3})->fetch_hash_all;
-is_deeply($rows, [{key1 => 3}], "$test : table and columns and where key");
-
-$rows = $dbi->select('table1', "order by key1 desc limit 1")->fetch_hash_all;
-is_deeply($rows, [{key1 => 3, key2 => 4}], "$test : append statement");
-
-$rows = $dbi->select('table1', {key1 => 2}, sub {
-    my $query = shift;
-    $query->bind_filter(sub {
-        my ($value, $key) = @_;
-        if ($key eq 'key1') {
-            return $value - 1;
-        }
-        return $value;
-    });
-})->fetch_hash_all;
-is_deeply($rows, [{key1 => 1, key2 => 2}], "$test : query edit call back");
-
-$dbi->do($CREATE_TABLE->{2});
-$dbi->insert('table2', {key1 => 1, key3 => 5});
-$rows = $dbi->select([qw/table1 table2/],
-                     ['table1.key1 as table1_key1', 'table2.key1 as table2_key1', 'key2', 'key3'],
-                     {'table1.key2' => 2},
-                     "where table1.key1 = table2.key1")->fetch_hash_all;
-is_deeply($rows, [{table1_key1 => 1, table2_key1 => 1, key2 => 2, key3 => 5}], "$test : join");
-
-test 'Cache';
-$dbi = DBIx::Custom->new($NEW_ARGS->{0});
-DBIx::Custom->query_cache_max(2);
-$dbi->do($CREATE_TABLE->{0});
-DBIx::Custom->delete_class_attr('_query_caches');
-DBIx::Custom->delete_class_attr('_query_cache_keys');
-$tmpls[0] = "insert into table1 {insert key1 key2}";
-$queries[0] = $dbi->create_query($tmpls[0]);
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{sql}, $queries[0]->sql, "$test : sql first");
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{key_infos}, $queries[0]->key_infos, "$test : key_infos first");
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls], "$test : cache key first");
-
-$tmpls[1] = "select * from table1";
-$queries[1] = $dbi->create_query($tmpls[1]);
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{sql}, $queries[0]->sql, "$test : sql first");
-is(DBIx::Custom->_query_caches->{$tmpls[0]}{key_infos}, $queries[0]->key_infos, "$test : key_infos first");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql second");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{key_infos}, $queries[1]->key_infos, "$test : key_infos second");
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls], "$test : cache key second");
-
-$tmpls[2] = "select key1, key2 from table1";
-$queries[2] = $dbi->create_query($tmpls[2]);
-ok(!exists DBIx::Custom->_query_caches->{$tmpls[0]}, "$test : cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{key_infos}, $queries[1]->key_infos, "$test : key_infos cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{sql}, $queries[2]->sql, "$test : sql cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{key_infos}, $queries[2]->key_infos, "$test : key_infos cache overflow deleted key");
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls[1, 2]], "$test : cache key third");
-
-$queries[1] = $dbi->create_query($tmpls[1]);
-ok(!exists DBIx::Custom->_query_caches->{$tmpls[0]}, "$test : cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{sql}, $queries[1]->sql, "$test : sql cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[1]}{key_infos}, $queries[1]->key_infos, "$test : key_infos cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{sql}, $queries[2]->sql, "$test : sql cache overflow deleted key");
-is(DBIx::Custom->_query_caches->{$tmpls[2]}{key_infos}, $queries[2]->key_infos, "$test : key_infos cache overflow deleted key");
-is_deeply(DBIx::Custom->_query_cache_keys, [@tmpls[1, 2]], "$test : cache key third");
-

-36

DBIx-Custom/t/101-mysql_private.t

View

@@ -1,36 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-
-# user password database
-our ($USER, $PASSWORD, $DATABASE) = connect_info();
-
-plan skip_all => 'private MySQL test' unless $USER;
-
-plan 'no_plan';
-
-use DBIx::Custom;
-use Scalar::Util 'blessed';
-{
-    my $dbi = DBIx::Custom->new(
-        user => $USER,
-        password => $PASSWORD,
-        data_source => "dbi:mysql:dbname=$DATABASE"
-    );
-    $dbi->connect;
-    
-    ok(blessed $dbi->dbh);
-    can_ok($dbi->dbh, qw/prepare/);
-}
-
-sub connect_info {
-    my $file = 'password.tmp';
-    open my $fh, '<', $file
-      or return;
-    
-    my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);
-    
-    close $fh;
-    
-    return ($user, $password, $database);
-}

-51

DBIx-Custom/t/boilerplate.t

View

@@ -1,51 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-sub not_in_file_ok {
-    my ($filename, %regex) = @_;
-    open( my $fh, '<', $filename )
-        or die "couldn't open $filename for reading: $!";
-
-    my %violated;
-
-    while (my $line = <$fh>) {
-        while (my ($desc, $regex) = each %regex) {
-            if ($line =~ $regex) {
-                push @{$violated{$desc}||=[]}, $.;
-            }
-        }
-    }
-
-    if (%violated) {
-        fail("$filename contains boilerplate text");
-        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
-    } else {
-        pass("$filename contains no boilerplate text");
-    }
-}
-
-sub module_boilerplate_ok {
-    my ($module) = @_;
-    not_in_file_ok($module =>
-        'the great new $MODULENAME'   => qr/ - The great new /,
-        'boilerplate description'     => qr/Quick summary of what the module/,
-        'stub function definition'    => qr/function[12]/,
-    );
-}
-
-
-  not_in_file_ok(README =>
-    "The README is used..."       => qr/The README is used/,
-    "'version information here'"  => qr/to provide version information/,
-  );
-
-  not_in_file_ok(Changes =>
-    "placeholder date/time"       => qr(Date/time)
-  );
-
-  module_boilerplate_ok('lib/DBIx/Custom.pm');
-
-

-18

DBIx-Custom/t/pod-coverage.t

View

@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod::Coverage
-my $min_tpc = 1.08;
-eval "use Test::Pod::Coverage $min_tpc";
-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
-    if $@;
-
-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
-# but older versions don't recognize some common documentation styles
-my $min_pc = 0.18;
-eval "use Pod::Coverage $min_pc";
-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
-    if $@;
-
-all_pod_coverage_ok();

-12

DBIx-Custom/t/pod.t

View

@@ -1,12 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More;
-
-# Ensure a recent version of Test::Pod
-my $min_tp = 1.22;
-eval "use Test::Pod $min_tp";
-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
-
-all_pod_files_ok();

-24

dist.pl

View

@@ -1,24 +0,0 @@
-use strict;
-use warnings;
-use File::Spec;
-
-my @modules = qw/DBIx-Custom DBIx-Custom-Basic DBIx-Custom-MySQL
-                 DBIx-Custom-Query DBIx-Custom-Result
-                 DBIx-Custom-Result DBIx-Custom-SQLite
-                 DBIx-Custom-SQL-Template/;
-
-foreach my $module (@modules) {
-    chdir $module
-      or die "Cannot change directory '$module': $!";
-    
-    system('perl Build realclean');
-    system('perl Build.PL');
-    system('perl Build');
-    system('perl Build test');
-    system('perl Build install');
-    system('perl Build disttest');
-    system('perl Build dist');
-    
-    chdir File::Spec->updir
-      or die "Cannot change up directory: $!";
-}

+2 -6

lib/DBIx/Custom.pm

View

@@ -448,12 +448,8 @@ sub run_transaction {
 # Get last insert id
 sub last_insert_id {
     my $self = shift;
-    
-    # Not connected
-    croak("Not yet connect to database")
-      unless $self->connected;
-    
-    return $self->dbh->last_insert_id(@_);
+    my $class = ref $self;
+    croak "'$class' do not suppert 'last_insert_id'";
 }
 
 # Insert

-4

lib/DBIx/Custom/Basic.pm

View

@@ -39,10 +39,6 @@ sub utf8_filter_on {
 
 DBIx::Custom::Basic - DBIx::Custom basic implementation
 
-=head1 Version
-
-Version 0.0201
-
 =head1 See DBIx::Custom documentation
 
 This class is L<DBIx::Custom> subclass.

+4 -4

DBIx-Custom-0.0501/lib/DBIx/Custom/MySQL.pm → lib/DBIx/Custom/DB2.pm

View

@@ -1,4 +1,4 @@
-package DBIx::Custom::MySQL;
+package DBIx::Custom::DB2;
 use base 'DBIx::Custom::Basic';
 
 use warnings;
@@ -17,7 +17,7 @@ sub connect {
     my $self = shift;
     
     if (!$self->data_source && (my $database = $self->database)) {
-        $self->data_source("dbi:mysql:dbname=$database");
+        $self->data_source("dbi:DB2:dbname=$database");
     }
     
     return $self->SUPER::connect;
@@ -25,7 +25,7 @@ sub connect {
 
 =head1 NAME
 
-DBIx::Custom::MySQL - DBIx::Custom MySQL implementation
+DBIx::Custom::DB2 - DBIx::Custom DB2 implementation
 
 =head1 Version
 
@@ -34,7 +34,7 @@ Version 0.0102
 =head1 Synopsys
 
     # New
-    my $dbi = DBIx::Custom::MySQL->new(user => 'taro', $password => 'kliej&@K',
+    my $dbi = DBIx::Custom::DB2->new(user => 'taro', $password => 'kliej&@K',
                                       database => 'sample_db');
     # Insert 
     $dbi->insert('books', {title => 'perl', author => 'taro'});

+20 -4

lib/DBIx/Custom/MySQL.pm

View

@@ -3,6 +3,7 @@ use base 'DBIx::Custom::Basic';
 
 use warnings;
 use strict;
+use Carp 'croak';
 
 my $class = __PACKAGE__;
 
@@ -23,14 +24,20 @@ sub connect {
     return $self->SUPER::connect;
 }
 
+sub last_insert_id {
+    my $self = shift;
+    
+    croak "Not yet connected" unless $self->connected;
+    
+    my $last_insert_id = $self->dbh->{mysql_insertid};
+    
+    return $last_insert_id;
+}
+
 =head1 NAME
 
 DBIx::Custom::MySQL - DBIx::Custom MySQL implementation
 
-=head1 Version
-
-Version 0.0102
-
 =head1 Synopsys
 
     # New
@@ -68,6 +75,15 @@ Please see L<DBIx::Custom::Basic> and <DBIx::Custom> documentation.
     
     If database attribute is set, automatically data source is created and connect
 
+=head2 last_insert_id
+
+    # Get last insert id
+    $last_insert_id = $self->last_insert_id;
+
+This is equal to MySQL function
+
+    last_insert_id()
+    
 =head1 Author
 
 Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>

+3 -30

DBIx-Custom-MySQL/lib/DBIx/Custom/MySQL.pm → lib/DBIx/Custom/ODBC.pm

View

@@ -1,24 +1,16 @@
-package DBIx::Custom::MySQL;
+package DBIx::Custom::ODBC;
 use base 'DBIx::Custom::Basic';
 
 use warnings;
 use strict;
-our $VERSION = '0.0102';
 
 my $class = __PACKAGE__;
 
-$class->add_format(
-    datetime => $class->formats->{SQL99_datetime},
-    date     => $class->formats->{SQL99_date},
-    time     => $class->formats->{SQL99_time},
-);
-
-
 sub connect {
     my $self = shift;
     
     if (!$self->data_source && (my $database = $self->database)) {
-        $self->data_source("dbi:mysql:dbname=$database");
+        $self->data_source("dbi:ODBC:dbname=$database");
     }
     
     return $self->SUPER::connect;
@@ -26,7 +18,7 @@ sub connect {
 
 =head1 NAME
 
-DBIx::Custom::MySQL - DBIx::Custom MySQL implementation
+DBIx::Custom::ODBC - DBIx::Custom ODBC implementation
 
 =head1 Version
 
@@ -34,25 +26,6 @@ Version 0.0102
 
 =head1 Synopsys
 
-    # New
-    my $dbi = DBIx::Custom::MySQL->new(user => 'taro', $password => 'kliej&@K',
-                                      database => 'sample_db');
-    # Insert 
-    $dbi->insert('books', {title => 'perl', author => 'taro'});
-    
-    # Update 
-    # same as 'update books set (title = 'aaa', author = 'ken') where id = 5;
-    $dbi->update('books', {title => 'aaa', author => 'ken'}, {id => 5});
-    
-    # Delete
-    $dbi->delete('books', {author => 'taro'});
-    
-    # select * from books;
-    $dbi->select('books');
-    
-    # select * from books where ahthor = 'taro'; 
-    $dbi->select('books', {author => 'taro'});
-
 =head1 See DBIx::Custom and DBI::Custom::Basic documentation
 
 This class is L<DBIx::Custom::Basic> subclass,

+5 -16

DBIx-Custom-0.0501/blib/lib/DBIx/Custom/MySQL.pm → lib/DBIx/Custom/Oracle.pm

View

@@ -1,4 +1,4 @@
-package DBIx::Custom::MySQL;
+package DBIx::Custom::Oracle;
 use base 'DBIx::Custom::Basic';
 
 use warnings;
@@ -6,18 +6,11 @@ use strict;
 
 my $class = __PACKAGE__;
 
-$class->add_format(
-    datetime => $class->formats->{SQL99_datetime},
-    date     => $class->formats->{SQL99_date},
-    time     => $class->formats->{SQL99_time},
-);
-
-
 sub connect {
     my $self = shift;
     
     if (!$self->data_source && (my $database = $self->database)) {
-        $self->data_source("dbi:mysql:dbname=$database");
+        $self->data_source("dbi:Oracle:dbname=$database");
     }
     
     return $self->SUPER::connect;
@@ -25,17 +18,13 @@ sub connect {
 
 =head1 NAME
 
-DBIx::Custom::MySQL - DBIx::Custom MySQL implementation
-
-=head1 Version
-
-Version 0.0102
+DBIx::Custom::Oracle - DBIx::Custom Oracle implementation
 
 =head1 Synopsys
 
     # New
-    my $dbi = DBIx::Custom::MySQL->new(user => 'taro', $password => 'kliej&@K',
-                                      database => 'sample_db');
+    my $dbi = DBIx::Custom::Oracle->new(user => 'taro', $password => 'kliej&@K',
+                                        database => 'sample_db');
     # Insert 
     $dbi->insert('books', {title => 'perl', author => 'taro'});
     

+59

lib/DBIx/Custom/Pg.pm

View

...	...	@@ -0,0 +1,59 @@
	1	+package DBIx::Custom::Pg;
	2	+use base 'DBIx::Custom::Basic';
	3	+
	4	+use warnings;
	5	+use strict;
	6	+
	7	+my $class = __PACKAGE__;
	8	+
	9	+
	10	+sub connect {
	11	+ my $self = shift;
	12	+
	13	+ if (!$self->data_source && (my $database = $self->database)) {
	14	+ $self->data_source("dbi:Pg:dbname=$database");
	15	+ }
	16	+
	17	+ return $self->SUPER::connect;
	18	+}
	19	+
	20	+=head1 NAME
	21	+
	22	+DBIx::Custom::Pg - DBIx::Custom PostgreSQL implementation
	23	+
	24	+=head1 Synopsys
	25	+
	26	+=head1 See DBIx::Custom and DBI::Custom::Basic documentation
	27	+
	28	+This class is L<DBIx::Custom::Basic> subclass,
	29	+and L<DBIx::Custom::Basic> is L<DBIx::Custom> subclass.
	30	+
	31	+You can use all methods of L<DBIx::Custom::Basic> and <DBIx::Custom>
	32	+Please see L<DBIx::Custom::Basic> and <DBIx::Custom> documentation.
	33	+
	34	+=head1 Object methods
	35	+
	36	+=head2 connect
	37	+
	38	+ This method override DBIx::Custom::connect
	39	+
	40	+ If database attribute is set, automatically data source is created and connect
	41	+
	42	+=head2 last_insert_id
	43	+
	44	+=head1 Author
	45	+
	46	+Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
	47	+
	48	+Github L<http://github.com/yuki-kimoto>
	49	+
	50	+I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
	51	+
	52	+=head1 Copyright & license
	53	+
	54	+Copyright 2009 Yuki Kimoto, all rights reserved.
	55	+
	56	+This program is free software; you can redistribute it and/or modify it
	57	+under the same terms as Perl itself.
	58	+
	59	+

+18

lib/DBIx/Custom/SQLite.pm

View

@@ -50,6 +50,15 @@ sub reconnect_memory {
     return $self;
 }
 
+sub last_insert_id {
+    my $self = shift;
+    
+    croak "Not yet connected" unless $self->connected;
+    
+    my $last_insert_id = $self->dbh->func('last_insert_rowid');
+    
+    return $last_insert_id;
+}
 
 =head1 NAME
 
@@ -119,6 +128,15 @@ If database attribute is set, automatically data source is created and connect
     # Reconnect memory database
     $self = $dbi->reconnect_memory;
 
+=head2 last_insert_id
+
+    # Get last insert id
+    $last_insert_id = $self->last_insert_id;
+
+This is equal to SQLite function
+
+    last_insert_rowid()
+
 =head1 Author
 
 Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>

...	...	@@ -1,25 +0,0 @@
1		-use strict;
2		-use warnings;
3		-use Module::Build;
4		-
5		-my $builder = Module::Build->new(
6		- module_name => 'DBIx::Custom',
7		- license => 'perl',
8		- dist_author => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
9		- dist_version_from => 'lib/DBIx/Custom.pm',
10		- build_requires => {
11		- 'Test::More' => 0,
12		- },
13		- recommends => {
14		- 'DBD::SQLite' => 1.25,
15		- 'Time::Piece' => 1.15
16		- },
17		- requires => {
18		- 'Object::Simple' => 2.0702,
19		- 'DBI' => 1.605,
20		- },
21		- add_to_cleanup => [ 'DBIx-Custom-*' ],
22		- create_makefile_pl => 'traditional',
23		-);
24		-
25		-$builder->create_build_script();

...	...	@@ -1,11 +0,0 @@
1		-0.0501
2		- packaging DBIx::Custom::Result DBIx::Custom::Query DBIx::Custom::MySQL DBIx::Custom::SQLite DBIx::Custom::SQL::Template
3		-0.0401
4		- catch up with DBIx::Custom::Result version up
5		-0.0301
6		- exchange filter argument 'key', 'value' (not backword compatible)
7		-0.0201
8		- rename tranzaction to transaction
9		- add filter_off
10		-0.0101
11		- First release

...	...	@@ -1,15 +0,0 @@
1		-DBIx-Custom
2		-
3		-Custamizable DBI
4		-
5		-INSTALLATION
6		-
7		-cpan DBIx::Custom
8		-
9		-COPYRIGHT AND LICENCE
10		-
11		-Copyright (C) 2009 Yuki Kimoto
12		-
13		-This program is free software; you can redistribute it and/or modify it
14		-under the same terms as Perl itself.
15		-

...	...	@@ -1,280 +0,0 @@
1		-do{ my $x = [
2		- {
3		- 'ARGV' => []
4		- },
5		- {},
6		- {
7		- 'verbose' => undef,
8		- 'PL_files' => undef,
9		- 'pollute' => undef,
10		- 'bindoc_dirs' => [
11		- 'blib/script'
12		- ],
13		- 'conflicts' => {},
14		- 'scripts' => undef,
15		- 'recommends' => {
16		- 'DBD::SQLite' => '1.25',
17		- 'Time::Piece' => '1.15'
18		- },
19		- 'dist_version' => bless( {
20		- 'original' => '0.0501',
21		- 'version' => [
22		- 0,
23		- 50,
24		- 100
25		- ]
26		- }, 'Module::Build::Version' ),
27		- 'pod_files' => undef,
28		- 'config_dir' => '_build',
29		- 'sign' => undef,
30		- 'recurse_into' => [],
31		- 'build_bat' => 0,
32		- 'extra_linker_flags' => [],
33		- 'build_class' => 'Module::Build',
34		- 'prereq_action_types' => [
35		- 'requires',
36		- 'build_requires',
37		- 'conflicts',
38		- 'recommends'
39		- ],
40		- 'base_dir' => '/root/labo/DBIx-Custom/DBIx-Custom-0.0501',
41		- 'allow_mb_mismatch' => 0,
42		- 'xs_files' => undef,
43		- 'destdir' => undef,
44		- 'metafile' => 'META.yml',
45		- 'mb_version' => '0.31012',
46		- 'use_tap_harness' => 0,
47		- 'test_file_exts' => [
48		- '.t'
49		- ],
50		- 'dist_name' => 'DBIx-Custom',
51		- 'has_config_data' => undef,
52		- 'install_base' => undef,
53		- 'module_name' => 'DBIx::Custom',
54		- 'recursive_test_files' => undef,
55		- 'libdoc_dirs' => [
56		- 'blib/lib',
57		- 'blib/arch'
58		- ],
59		- 'perl' => '/usr/bin/perl',
60		- 'dist_author' => [
61		- 'Yuki Kimoto <kimoto.yuki@gmail.com>'
62		- ],
63		- 'use_rcfile' => 1,
64		- 'configure_requires' => {},
65		- 'test_files' => undef,
66		- 'dist_abstract' => undef,
67		- 'create_readme' => undef,
68		- 'prefix_relpaths' => {
69		- 'core' => {
70		- 'libdoc' => [
71		- 'man',
72		- 'man3'
73		- ],
74		- 'script' => [
75		- 'bin'
76		- ],
77		- 'libhtml' => [
78		- 'html'
79		- ],
80		- 'bindoc' => [
81		- 'man',
82		- 'man1'
83		- ],
84		- 'bin' => [
85		- 'bin'
86		- ],
87		- 'arch' => [
88		- 'lib',
89		- 'perl5',
90		- '5.8.8',
91		- 'i386-linux-thread-multi'
92		- ],
93		- 'binhtml' => [
94		- 'html'
95		- ],
96		- 'lib' => [
97		- 'lib',
98		- 'perl5'
99		- ]
100		- },
101		- 'site' => {
102		- 'libdoc' => [
103		- 'man',
104		- 'man3'
105		- ],
106		- 'script' => [
107		- 'bin'
108		- ],
109		- 'libhtml' => [
110		- 'html'
111		- ],
112		- 'bindoc' => [
113		- 'man',
114		- 'man1'
115		- ],
116		- 'bin' => [
117		- 'bin'
118		- ],
119		- 'arch' => [
120		- 'lib',
121		- 'perl5',
122		- 'site_perl',
123		- '5.8.8',
124		- 'i386-linux-thread-multi'
125		- ],
126		- 'binhtml' => [
127		- 'html'
128		- ],
129		- 'lib' => [
130		- 'lib',
131		- 'perl5',
132		- 'site_perl'
133		- ]
134		- },
135		- 'vendor' => {
136		- 'libdoc' => [
137		- 'man',
138		- 'man3'
139		- ],
140		- 'script' => [
141		- 'bin'
142		- ],
143		- 'libhtml' => [
144		- 'html'
145		- ],
146		- 'bindoc' => [
147		- 'man',
148		- 'man1'
149		- ],
150		- 'bin' => [
151		- 'bin'
152		- ],
153		- 'arch' => [
154		- 'lib',
155		- 'perl5',
156		- '5.8.8',
157		- 'i386-linux-thread-multi'
158		- ],
159		- 'binhtml' => [
160		- 'html'
161		- ],
162		- 'lib' => [
163		- 'lib',
164		- 'perl5'
165		- ]
166		- }
167		- },
168		- 'meta_merge' => {},
169		- 'get_options' => {},
170		- 'dist_version_from' => 'lib/DBIx/Custom.pm',
171		- 'create_license' => undef,
172		- 'debugger' => undef,
173		- 'html_css' => '',
174		- 'build_elements' => [
175		- 'PL',
176		- 'support',
177		- 'pm',
178		- 'xs',
179		- 'pod',
180		- 'script'
181		- ],
182		- 'orig_dir' => '/root/labo/DBIx-Custom/DBIx-Custom-0.0501',
183		- 'include_dirs' => [],
184		- 'installdirs' => 'site',
185		- 'create_makefile_pl' => 'traditional',
186		- 'magic_number' => undef,
187		- 'install_sets' => {
188		- 'core' => {
189		- 'libdoc' => '/usr/share/man/man3',
190		- 'script' => '/usr/bin',
191		- 'libhtml' => undef,
192		- 'bindoc' => '/usr/share/man/man1',
193		- 'bin' => '/usr/bin',
194		- 'arch' => '/usr/lib/perl5/5.8.8/i386-linux-thread-multi',
195		- 'binhtml' => undef,
196		- 'lib' => '/usr/lib/perl5/5.8.8'
197		- },
198		- 'site' => {
199		- 'libdoc' => '/usr/share/man/man3',
200		- 'script' => '/usr/bin',
201		- 'libhtml' => undef,
202		- 'bindoc' => '/usr/share/man/man1',
203		- 'bin' => '/usr/bin',
204		- 'arch' => '/usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi',
205		- 'binhtml' => undef,
206		- 'lib' => '/usr/lib/perl5/site_perl/5.8.8'
207		- },
208		- 'vendor' => {
209		- 'libdoc' => '/usr/share/man/man3',
210		- 'script' => '/usr/bin',
211		- 'libhtml' => undef,
212		- 'bindoc' => '/usr/share/man/man1',
213		- 'bin' => '/usr/bin',
214		- 'arch' => '/usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi',
215		- 'binhtml' => undef,
216		- 'lib' => '/usr/lib/perl5/vendor_perl/5.8.8'
217		- }
218		- },
219		- 'tap_harness_args' => {},
220		- 'install_base_relpaths' => {
221		- 'libdoc' => [
222		- 'man',
223		- 'man3'
224		- ],
225		- 'script' => [
226		- 'bin'
227		- ],
228		- 'libhtml' => [
229		- 'html'
230		- ],
231		- 'bindoc' => [
232		- 'man',
233		- 'man1'
234		- ],
235		- 'bin' => [
236		- 'bin'
237		- ],
238		- 'arch' => [
239		- 'lib',
240		- 'perl5',
241		- 'i386-linux-thread-multi'
242		- ],
243		- 'binhtml' => [
244		- 'html'
245		- ],
246		- 'lib' => [
247		- 'lib',
248		- 'perl5'
249		- ]
250		- },
251		- 'meta_add' => {},
252		- 'create_packlist' => 1,
253		- 'requires' => {
254		- 'Object::Simple' => '2.0702',
255		- 'DBI' => '1.605'
256		- },
257		- 'install_path' => {},
258		- 'pm_files' => undef,
259		- 'quiet' => undef,
260		- 'script_files' => undef,
261		- 'extra_compiler_flags' => [],
262		- 'build_script' => 'Build',
263		- 'original_prefix' => {
264		- 'core' => '/usr',
265		- 'site' => '/usr',
266		- 'vendor' => '/usr'
267		- },
268		- 'c_source' => undef,
269		- 'autosplit' => undef,
270		- 'program_name' => undef,
271		- 'license' => 'perl',
272		- 'build_requires' => {
273		- 'Test::More' => 0
274		- },
275		- 'config' => undef,
276		- 'blib' => 'blib',
277		- 'prefix' => undef
278		- }
279		- ];
280		-$x; }

...	...	@@ -1,117 +0,0 @@
1		-package DBIx::Custom::Basic;
2		-use 5.008001;
3		-use base 'DBIx::Custom';
4		-use Encode qw/decode encode/;
5		-
6		-use warnings;
7		-use strict;
8		-
9		-my $class = __PACKAGE__;
10		-
11		-$class->add_filter(
12		- encode_utf8 => sub {
13		- my $value = shift;
14		- utf8::upgrade($value) unless Encode::is_utf8($value);
15		- return encode('UTF-8', $value);
16		- },
17		- decode_utf8 => sub { decode('UTF-8', shift) }
18		-);
19		-
20		-$class->add_format(
21		- 'SQL99_date' => '%Y-%m-%d',
22		- 'SQL99_datetime' => '%Y-%m-%d %H:%M:%S',
23		- 'SQL99_time' => '%H:%M:%S',
24		- 'ISO-8601_date' => '%Y-%m-%d',
25		- 'ISO-8601_datetime' => '%Y-%m-%dT%H:%M:%S',
26		- 'ISO-8601_time' => '%H:%M:%S',
27		-);
28		-
29		-# Methods
30		-sub utf8_filter_on {
31		- my $self = shift;
32		- $self->bind_filter($self->filters->{encode_utf8});
33		- $self->fetch_filter($self->filters->{decode_utf8});
34		-}
35		-
36		-1;
37		-
38		-=head1 NAME
39		-
40		-DBIx::Custom::Basic - DBIx::Custom basic implementation
41		-
42		-=head1 Version
43		-
44		-Version 0.0201
45		-
46		-=head1 See DBIx::Custom documentation
47		-
48		-This class is L<DBIx::Custom> subclass.
49		-
50		-You can use all methods of L<DBIx::Custom>
51		-
52		-Please see L<DBIx::Custom> documentation
53		-
54		-=head1 Filters
55		-
56		-=head2 encode_utf8
57		-
58		- # Encode to UTF-8 byte stream (utf8::upgrade is done if need)
59		- $dbi->filters->{encode_utf8}->($value);
60		-
61		-This filter is generally used as bind filter
62		-
63		- $dbi->bind_filter($dbi->filters->{encode_utf8});
64		-
65		-=head2 decode_utf8
66		-
67		- # Decode to perl internal string
68		- $dbi->filters->{decode_utf8}->($value);
69		-
70		-This filter is generally used as fetch filter
71		-
72		- $dbi->fetch_filter($dbi->filters->{decode_utf8});
73		-
74		-=head2 Formats
75		-
76		-strptime formats is available
77		-
78		- # format name format
79		- 'SQL99_date' '%Y-%m-%d',
80		- 'SQL99_datetime' '%Y-%m-%d %H:%M:%S',
81		- 'SQL99_time' '%H:%M:%S',
82		- 'ISO-8601_date' '%Y-%m-%d',
83		- 'ISO-8601_datetime' '%Y-%m-%dT%H:%M:%S',
84		- 'ISO-8601_time' '%H:%M:%S',
85		-
86		-You get format as the following
87		-
88		- my $format = $dbi->formats->{$format_name};
89		-
90		-=head1 Methods
91		-
92		-=head2 utf8_filter_on
93		-
94		- # Encode and decode utf8 filter on
95		- $dbi->utf8_filter_on;
96		-
97		-This equel to
98		-
99		- $dbi->bind_filter($dbi->filters->{encode_utf8});
100		- $dbi->fetch_filter($dbi->filters->{decode_utf8});
101		-
102		-=head1 AUTHOR
103		-
104		-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
105		-
106		-Github L<http://github.com/yuki-kimoto>
107		-
108		-I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
109		-
110		-=head1 COPYRIGHT & LICENSE
111		-
112		-Copyright 2009 Yuki Kimoto, all rights reserved.
113		-
114		-This program is free software; you can redistribute it and/or modify it
115		-under the same terms as Perl itself.
116		-
117		-=cut

...	...	@@ -1,101 +0,0 @@
1		-package DBIx::Custom::Query;
2		-use Object::Simple;
3		-
4		-sub sql : Attr {}
5		-sub key_infos : Attr {}
6		-sub bind_filter : Attr {}
7		-sub fetch_filter : Attr {}
8		-sub sth : Attr {}
9		-
10		-sub no_bind_filters : Attr { type => 'array', trigger => sub {
11		- my $self = shift;
12		- my $no_bind_filters = $self->no_bind_filters \|\| [];
13		- my %no_bind_filters_map = map {$_ => 1} @{$no_bind_filters};
14		- $self->_no_bind_filters_map(\%no_bind_filters_map);
15		-}}
16		-sub _no_bind_filters_map : Attr {default => sub { {} }}
17		-
18		-sub no_fetch_filters : Attr { type => 'array', default => sub { [] } }
19		-
20		-Object::Simple->build_class;
21		-
22		-=head1 NAME
23		-
24		-DBIx::Custom::Query - Query object for DBIx::Custom
25		-
26		-=head1 VERSION
27		-
28		-Version 0.0101
29		-
30		-=head1 SYNOPSIS
31		-
32		- # Create query
33		- my $dbi = DBIx::Custom->new;
34		- my $query = $dbi->create_query($template);
35		-
36		- # Set query attributes
37		- $query->bind_filter($dbi->filters->{default_bind_filter});
38		- $query->no_bind_filters('title', 'author');
39		-
40		- $query->fetch_filter($dbi->filters->{default_fetch_filter});
41		- $query->no_fetch_filters('title', 'author');
42		-
43		- # Execute query
44		- $dbi->execute($query, $params);
45		-
46		-=head1 OBJECT ACCESSORS
47		-
48		-=head2 sth
49		-
50		- # Set and get statement handle
51		- $self = $query->sth($sql);
52		- $sth = $query->sth;
53		-
54		-=head2 sql
55		-
56		- # Set and get SQL
57		- $self = $query->sql($sql);
58		- $sql = $query->sql;
59		-
60		-=head2 bind_filter
61		-
62		- # Set and get bind filter
63		- $self = $query->bind_filter($bind_filter);
64		- $bind_filter = $query->bind_filter;
65		-
66		-=head2 no_bind_filters
67		-
68		- # Set and get keys of no filtering
69		- $self = $query->no_bind_filters($no_filters);
70		- $no_bind_filters = $query->no_bind_filters;
71		-
72		-=head2 fetch_filter
73		-
74		- # Set and get fetch filter
75		- $self = $query->fetch_filter($fetch_filter);
76		- $fetch_filter = $query->fetch_filter;
77		-
78		-=head2 no_fetch_filters
79		-
80		- # Set and get keys of no filtering
81		- $self = $query->no_fetch_filters($no_filters);
82		- $no_fetch_filters = $query->no_fetch_filters;
83		-
84		-=head2 key_infos
85		-
86		- # Set and get key informations
87		- $self = $query->key_infos($key_infos);
88		- $key_infos = $query->key_infos;
89		-
90		-=head1 AUTHOR
91		-
92		-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
93		-
94		-Github L<http://github.com/yuki-kimoto>
95		-
96		-=head1 COPYRIGHT & LICENSE
97		-
98		-Copyright 2009 Yuki Kimoto, all rights reserved.
99		-
100		-This program is free software; you can redistribute it and/or modify it
101		-under the same terms as Perl itself.

...	...	@@ -1,384 +0,0 @@
1		-package DBIx::Custom::Result;
2		-use Object::Simple;
3		-use strict;
4		-use warnings;
5		-use Carp 'croak';
6		-
7		-# Attributes
8		-sub sth : Attr {}
9		-sub fetch_filter : Attr {}
10		-sub no_fetch_filters : Attr { type => 'array', trigger => sub {
11		- my $self = shift;
12		- my $no_fetch_filters = $self->no_fetch_filters \|\| [];
13		- my %no_fetch_filters_map = map {$_ => 1} @{$no_fetch_filters};
14		- $self->_no_fetch_filters_map(\%no_fetch_filters_map);
15		-}}
16		-sub _no_fetch_filters_map : Attr {default => sub { {} }}
17		-
18		-# Fetch (array)
19		-sub fetch {
20		- my ($self, $type) = @_;
21		- my $sth = $self->sth;
22		- my $fetch_filter = $self->fetch_filter;
23		-
24		- # Fetch
25		- my $row = $sth->fetchrow_arrayref;
26		-
27		- # Cannot fetch
28		- return unless $row;
29		-
30		- # Filter
31		- if ($fetch_filter) {
32		- my $keys = $sth->{NAME_lc};
33		- my $types = $sth->{TYPE};
34		- for (my $i = 0; $i < @$keys; $i++) {
35		- next if $self->_no_fetch_filters_map->{$keys->[$i]};
36		- $row->[$i]= $fetch_filter->($row->[$i], $keys->[$i], $types->[$i],
37		- $sth, $i);
38		- }
39		- }
40		- return wantarray ? @$row : $row;
41		-}
42		-
43		-# Fetch (hash)
44		-sub fetch_hash {
45		- my $self = shift;
46		- my $sth = $self->sth;
47		- my $fetch_filter = $self->fetch_filter;
48		-
49		- # Fetch
50		- my $row = $sth->fetchrow_arrayref;
51		-
52		- # Cannot fetch
53		- return unless $row;
54		-
55		- # Keys
56		- my $keys = $sth->{NAME_lc};
57		-
58		- # Filter
59		- my $row_hash = {};
60		- if ($fetch_filter) {
61		- my $types = $sth->{TYPE};
62		- for (my $i = 0; $i < @$keys; $i++) {
63		- if ($self->_no_fetch_filters_map->{$keys->[$i]}) {
64		- $row_hash->{$keys->[$i]} = $row->[$i];
65		- }
66		- else {
67		- $row_hash->{$keys->[$i]}
68		- = $fetch_filter->($row->[$i], $keys->[$i],
69		- $types->[$i], $sth, $i);
70		- }
71		- }
72		- }
73		-
74		- # No filter
75		- else {
76		- for (my $i = 0; $i < @$keys; $i++) {
77		- $row_hash->{$keys->[$i]} = $row->[$i];
78		- }
79		- }
80		- return wantarray ? %$row_hash : $row_hash;
81		-}
82		-
83		-# Fetch only first (array)
84		-sub fetch_first {
85		- my $self = shift;
86		-
87		- # Fetch
88		- my $row = $self->fetch;
89		-
90		- # Not exist
91		- return unless $row;
92		-
93		- # Finish statement handle
94		- $self->finish;
95		-
96		- return wantarray ? @$row : $row;
97		-}
98		-
99		-# Fetch only first (hash)
100		-sub fetch_hash_first {
101		- my $self = shift;
102		-
103		- # Fetch hash
104		- my $row = $self->fetch_hash;
105		-
106		- # Not exist
107		- return unless $row;
108		-
109		- # Finish statement handle
110		- $self->finish;
111		-
112		- return wantarray ? %$row : $row;
113		-}
114		-
115		-# Fetch multi rows (array)
116		-sub fetch_rows {
117		- my ($self, $count) = @_;
118		-
119		- # Not specified Row count
120		- croak("Row count must be specified")
121		- unless $count;
122		-
123		- # Fetch multi rows
124		- my $rows = [];
125		- for (my $i = 0; $i < $count; $i++) {
126		- my @row = $self->fetch;
127		-
128		- last unless @row;
129		-
130		- push @$rows, \@row;
131		- }
132		-
133		- return unless @$rows;
134		- return wantarray ? @$rows : $rows;
135		-}
136		-
137		-# Fetch multi rows (hash)
138		-sub fetch_hash_rows {
139		- my ($self, $count) = @_;
140		-
141		- # Not specified Row count
142		- croak("Row count must be specified")
143		- unless $count;
144		-
145		- # Fetch multi rows
146		- my $rows = [];
147		- for (my $i = 0; $i < $count; $i++) {
148		- my %row = $self->fetch_hash;
149		-
150		- last unless %row;
151		-
152		- push @$rows, \%row;
153		- }
154		-
155		- return unless @$rows;
156		- return wantarray ? @$rows : $rows;
157		-}
158		-
159		-
160		-# Fetch all (array)
161		-sub fetch_all {
162		- my $self = shift;
163		-
164		- my $rows = [];
165		- while(my @row = $self->fetch) {
166		- push @$rows, [@row];
167		- }
168		- return wantarray ? @$rows : $rows;
169		-}
170		-
171		-# Fetch all (hash)
172		-sub fetch_hash_all {
173		- my $self = shift;
174		-
175		- my $rows = [];
176		- while(my %row = $self->fetch_hash) {
177		- push @$rows, {%row};
178		- }
179		- return wantarray ? @$rows : $rows;
180		-}
181		-
182		-# Finish
183		-sub finish { shift->sth->finish }
184		-
185		-# Error
186		-sub error {
187		- my $self = shift;
188		- my $sth = $self->sth;
189		- return wantarray ? ($sth->errstr, $sth->err, $sth->state) : $sth->errstr;
190		-}
191		-
192		-Object::Simple->build_class;
193		-
194		-=head1 NAME
195		-
196		-DBIx::Custom::Result - Resultset for DBIx::Custom
197		-
198		-=head1 VERSION
199		-
200		-Version 0.0301
201		-
202		-=head1 SYNOPSIS
203		-
204		- # $result is DBIx::Custom::Result object
205		- my $dbi = DBIx::Custom->new;
206		- my $result = $dbi->query($sql_template, $param);
207		-
208		- while (my ($val1, $val2) = $result->fetch) {
209		- # do something
210		- }
211		-
212		-=head1 OBJECT ACCESSORS
213		-
214		-=head2 sth
215		-
216		- # Set and Get statement handle
217		- $self = $result->sth($sth);
218		- $sth = $reuslt->sth
219		-
220		-Statement handle is automatically set by DBIx::Custom.
221		-so you do not set statement handle.
222		-
223		-If you need statement handle, you can get statement handle by using this method.
224		-
225		-=head2 fetch_filter
226		-
227		- # Set and Get fetch filter
228		- $self = $result->fetch_filter($sth);
229		- $fetch_filter = $result->fech_filter;
230		-
231		-Statement handle is automatically set by DBIx::Custom.
232		-If you want to set your fetch filter, you set it.
233		-
234		-=head2 no_fetch_filters
235		-
236		- # Set and Get no filter keys when fetching
237		- $self = $result->no_fetch_filters($no_fetch_filters);
238		- $no_fetch_filters = $result->no_fetch_filters;
239		-
240		-=head1 METHODS
241		-
242		-=head2 fetch
243		-
244		- # Fetch row as array reference (Scalar context)
245		- $row = $result->fetch;
246		-
247		- # Fetch row as array (List context)
248		- @row = $result->fecth
249		-
250		- # Sample
251		- while (my $row = $result->fetch) {
252		- # do something
253		- my $val1 = $row->[0];
254		- my $val2 = $row->[1];
255		- }
256		-
257		-fetch method is fetch resultset and get row as array or array reference.
258		-
259		-=head2 fetch_hash
260		-
261		- # Fetch row as hash reference (Scalar context)
262		- $row = $result->fetch_hash;
263		-
264		- # Fetch row as hash (List context)
265		- %row = $result->fecth_hash
266		-
267		- # Sample
268		- while (my $row = $result->fetch_hash) {
269		- # do something
270		- my $val1 = $row->{key1};
271		- my $val2 = $row->{key2};
272		- }
273		-
274		-fetch_hash method is fetch resultset and get row as hash or hash reference.
275		-
276		-=head2 fetch_first
277		-
278		- # Fetch only first (Scalar context)
279		- $row = $result->fetch_first;
280		-
281		- # Fetch only first (List context)
282		- @row = $result->fetch_first;
283		-
284		-This method fetch only first and finish statement handle
285		-
286		-=head2 fetch_hash_first
287		-
288		- # Fetch only first as hash (Scalar context)
289		- $row = $result->fetch_hash_first;
290		-
291		- # Fetch only first as hash (Scalar context)
292		- @row = $result->fetch_hash_first;
293		-
294		-This method fetch only first and finish statement handle
295		-
296		-=head2 fetch_rows
297		-
298		- # Fetch multi rows (Scalar context)
299		- $rows = $result->fetch_rows($row_count);
300		-
301		- # Fetch multi rows (List context)
302		- @rows = $result->fetch_rows($row_count);
303		-
304		- # Sapmle
305		- $rows = $result->fetch_rows(10);
306		-
307		-=head2 fetch_hash_rows
308		-
309		- # Fetch multi rows as hash (Scalar context)
310		- $rows = $result->fetch_hash_rows($row_count);
311		-
312		- # Fetch multi rows as hash (List context)
313		- @rows = $result->fetch_hash_rows($row_count);
314		-
315		- # Sapmle
316		- $rows = $result->fetch_hash_rows(10);
317		-
318		-=head2 fetch_all
319		-
320		- # Fetch all row as array ref of array ref (Scalar context)
321		- $rows = $result->fetch_all;
322		-
323		- # Fetch all row as array of array ref (List context)
324		- @rows = $result->fecth_all;
325		-
326		- # Sample
327		- my $rows = $result->fetch_all;
328		- my $val0_0 = $rows->[0][0];
329		- my $val1_1 = $rows->[1][1];
330		-
331		-fetch_all method is fetch resultset and get all rows as array or array reference.
332		-
333		-=head2 fetch_hash_all
334		-
335		- # Fetch all row as array ref of hash ref (Scalar context)
336		- $rows = $result->fetch_hash_all;
337		-
338		- # Fetch all row as array of hash ref (List context)
339		- @rows = $result->fecth_all_hash;
340		-
341		- # Sample
342		- my $rows = $result->fetch_hash_all;
343		- my $val0_key1 = $rows->[0]{key1};
344		- my $val1_key2 = $rows->[1]{key2};
345		-
346		-=head2 error
347		-
348		- # Get error infomation
349		- $error_messege = $result->error;
350		- ($error_message, $error_number, $error_state) = $result->error;
351		-
352		-You can get get information. This is crenspond to the following.
353		-
354		- $error_message : $result->sth->errstr
355		- $error_number : $result->sth->err
356		- $error_state : $result->sth->state
357		-
358		-=head2 finish
359		-
360		- # Finish statement handle
361		- $result->finish
362		-
363		- # Sample
364		- my $row = $reuslt->fetch; # fetch only one row
365		- $result->finish
366		-
367		-You can finish statement handle.This is equel to
368		-
369		- $result->sth->finish;
370		-
371		-=head1 AUTHOR
372		-
373		-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
374		-
375		-Github L<http://github.com/yuki-kimoto>
376		-
377		-=head1 COPYRIGHT & LICENSE
378		-
379		-Copyright 2009 Yuki Kimoto, all rights reserved.
380		-
381		-This program is free software; you can redistribute it and/or modify it
382		-under the same terms as Perl itself.
383		-
384		-=cut

...	...	@@ -1,694 +0,0 @@
1		-package DBIx::Custom::SQL::Template;
2		-use Object::Simple;
3		-
4		-use Carp 'croak';
5		-
6		-# Accessor is created by Object::Simple. Please read Object::Simple document
7		-
8		-### Class-Object accessors
9		-
10		-# Tag start
11		-sub tag_start : ClassObjectAttr {
12		- initialize => {default => '{', clone => 'scalar'}
13		-}
14		-
15		-# Tag end
16		-sub tag_end : ClassObjectAttr {
17		- initialize => {default => '}', clone => 'scalar'}
18		-}
19		-
20		-# Tag syntax
21		-sub tag_syntax : ClassObjectAttr {
22		- initialize => {default => <<'EOS', clone => 'scalar'}}
23		-[tag] [expand]
24		-{? name} ?
25		-{= name} name = ?
26		-{<> name} name <> ?
27		-
28		-{< name} name < ?
29		-{> name} name > ?
30		-{>= name} name >= ?
31		-{<= name} name <= ?
32		-
33		-{like name} name like ?
34		-{in name number} name in [?, ?, ..]
35		-
36		-{insert key1 key2} (key1, key2) values (?, ?)
37		-{update key1 key2} set key1 = ?, key2 = ?
38		-EOS
39		-
40		-# Tag processors
41		-sub tag_processors : ClassObjectAttr {
42		- type => 'hash',
43		- deref => 1,
44		- initialize => {
45		- clone => 'hash',
46		- default => sub {{
47		- '?' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
48		- '=' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
49		- '<>' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
50		- '>' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
51		- '<' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
52		- '>=' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
53		- '<=' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
54		- 'like' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_basic_tag,
55		- 'in' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_in_tag,
56		- 'insert' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_insert_tag,
57		- 'update' => \&DBIx::Custom::SQL::Template::TagProcessor::expand_update_tag
58		- }}
59		- }
60		-}
61		-
62		-# Add Tag processor
63		-sub add_tag_processor {
64		- my $invocant = shift;
65		- my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
66		- $invocant->tag_processors(%{$invocant->tag_processors}, %{$tag_processors});
67		- return $invocant;
68		-}
69		-
70		-# Clone
71		-sub clone {
72		- my $self = shift;
73		- my $new = $self->new;
74		-
75		- $new->tag_start($self->tag_start);
76		- $new->tag_end($self->tag_end);
77		- $new->tag_syntax($self->tag_syntax);
78		- $new->tag_processors({%{$self->tag_processors \|\| {}}});
79		-
80		- return $new;
81		-}
82		-
83		-
84		-### Object Methods
85		-
86		-# Create Query
87		-sub create_query {
88		- my ($self, $template) = @_;
89		-
90		- # Parse template
91		- my $tree = $self->_parse_template($template);
92		-
93		- # Build query
94		- my $query = $self->_build_query($tree);
95		-
96		- return $query;
97		-}
98		-
99		-# Parse template
100		-sub _parse_template {
101		- my ($self, $template) = @_;
102		- $template \|\|= '';
103		-
104		- my $tree = [];
105		-
106		- # Tags
107		- my $tag_start = quotemeta $self->tag_start;
108		- my $tag_end = quotemeta $self->tag_end;
109		-
110		- # Tokenize
111		- my $state = 'text';
112		-
113		- # Save original template
114		- my $original_template = $template;
115		-
116		- # Parse template
117		- while ($template =~ s/([^$tag_start]?)$tag_start([^$tag_end].?)$tag_end//sm) {
118		- my $text = $1;
119		- my $tag = $2;
120		-
121		- # Parse tree
122		- push @$tree, {type => 'text', tag_args => [$text]} if $text;
123		-
124		- if ($tag) {
125		- # Get tag name and arguments
126		- my ($tag_name, @tag_args) = split /\s+/, $tag;
127		-
128		- # Tag processor is exist?
129		- unless ($self->tag_processors->{$tag_name}) {
130		- my $tag_syntax = $self->tag_syntax;
131		- croak("Tag '{$tag}' in SQL template is not exist.\n\n" .
132		- "<SQL template tag syntax>\n" .
133		- "$tag_syntax\n" .
134		- "<Your SQL template>\n" .
135		- "$original_template\n\n");
136		- }
137		-
138		- # Check tag arguments
139		- foreach my $tag_arg (@tag_args) {
140		- # Cannot cantain placehosder '?'
141		- croak("Tag '{t }' arguments cannot contain '?'")
142		- if $tag_arg =~ /\?/;
143		- }
144		-
145		- # Add tag to parsing tree
146		- push @$tree, {type => 'tag', tag_name => $tag_name, tag_args => [@tag_args]};
147		- }
148		- }
149		-
150		- # Add text to parsing tree
151		- push @$tree, {type => 'text', tag_args => [$template]} if $template;
152		-
153		- return $tree;
154		-}
155		-
156		-# Build SQL from parsing tree
157		-sub _build_query {
158		- my ($self, $tree) = @_;
159		-
160		- # SQL
161		- my $sql = '';
162		-
163		- # All parameter key infomation
164		- my $all_key_infos = [];
165		-
166		- # Build SQL
167		- foreach my $node (@$tree) {
168		-
169		- # Get type, tag name, and arguments
170		- my $type = $node->{type};
171		- my $tag_name = $node->{tag_name};
172		- my $tag_args = $node->{tag_args};
173		-
174		- # Text
175		- if ($type eq 'text') {
176		- # Join text
177		- $sql .= $tag_args->[0];
178		- }
179		-
180		- # Tag
181		- elsif ($type eq 'tag') {
182		-
183		- # Get tag processor
184		- my $tag_processor = $self->tag_processors->{$tag_name};
185		-
186		- # Tag processor is code ref?
187		- croak("Tag processor '$tag_name' must be code reference")
188		- unless ref $tag_processor eq 'CODE';
189		-
190		- # Expand tag using tag processor
191		- my ($expand, $key_infos)
192		- = $tag_processor->($tag_name, $tag_args);
193		-
194		- # Check tag processor return value
195		- croak("Tag processor '$tag_name' must return (\$expand, \$key_infos)")
196		- if !defined $expand \|\| ref $key_infos ne 'ARRAY';
197		-
198		- # Check placeholder count
199		- croak("Placeholder count in SQL created by tag processor '$tag_name' " .
200		- "must be same as key informations count")
201		- unless $self->_placeholder_count($expand) eq @$key_infos;
202		-
203		- # Add key information
204		- push @$all_key_infos, @$key_infos;
205		-
206		- # Join expand tag to SQL
207		- $sql .= $expand;
208		- }
209		- }
210		-
211		- # Add semicolon
212		- $sql .= ';' unless $sql =~ /;$/;
213		-
214		- # Query
215		- my $query = {sql => $sql, key_infos => $all_key_infos};
216		-
217		- return $query;
218		-}
219		-
220		-# Get placeholder count
221		-sub _placeholder_count {
222		- my ($self, $expand) = @_;
223		- $expand \|\|= '';
224		-
225		- my $count = 0;
226		- my $pos = -1;
227		- while (($pos = index($expand, '?', $pos + 1)) != -1) {
228		- $count++;
229		- }
230		- return $count;
231		-}
232		-
233		-Object::Simple->build_class;
234		-
235		-
236		-package DBIx::Custom::SQL::Template::TagProcessor;
237		-use strict;
238		-use warnings;
239		-use Carp 'croak';
240		-
241		-# Expand tag '?', '=', '<>', '>', '<', '>=', '<=', 'like'
242		-sub expand_basic_tag {
243		- my ($tag_name, $tag_args) = @_;
244		- my $original_key = $tag_args->[0];
245		-
246		- # Key is not exist
247		- croak("You must be pass key as argument to tag '{$tag_name }'")
248		- if !$original_key;
249		-
250		- # Expanded tag
251		- my $expand = $tag_name eq '?'
252		- ? '?'
253		- : "$original_key $tag_name ?";
254		-
255		- # Get table and clumn name
256		- my ($table, $column) = get_table_and_column($original_key);
257		-
258		- # Parameter key infomation
259		- my $key_info = {};
260		-
261		- # Original key
262		- $key_info->{original_key} = $original_key;
263		-
264		- # Table
265		- $key_info->{table} = $table;
266		-
267		- # Column name
268		- $key_info->{column} = $column;
269		-
270		- # Access keys
271		- my $access_keys = [];
272		- push @$access_keys, [$original_key];
273		- push @$access_keys, [$table, $column] if $table && $column;
274		- $key_info->{access_keys} = $access_keys;
275		-
276		- # Add parameter key information
277		- my $key_infos = [];
278		- push @$key_infos, $key_info;
279		-
280		- return ($expand, $key_infos);
281		-}
282		-
283		-# Expand tag 'in'
284		-sub expand_in_tag {
285		- my ($tag_name, $tag_args) = @_;
286		- my ($original_key, $placeholder_count) = @$tag_args;
287		-
288		- # Key must be specified
289		- croak("You must be pass key as first argument of tag '{$tag_name }'\n" .
290		- "Usage: {$tag_name \$key \$placeholder_count}")
291		- unless $original_key;
292		-
293		-
294		- # Place holder count must be specified
295		- croak("You must be pass placeholder count as second argument of tag '{$tag_name }'\n" .
296		- "Usage: {$tag_name \$key \$placeholder_count}")
297		- if !$placeholder_count \|\| $placeholder_count =~ /\D/;
298		-
299		- # Expand tag
300		- my $expand = "$original_key $tag_name (";
301		- for (my $i = 0; $i < $placeholder_count; $i++) {
302		- $expand .= '?, ';
303		- }
304		-
305		- $expand =~ s/, $//;
306		- $expand .= ')';
307		-
308		- # Get table and clumn name
309		- my ($table, $column) = get_table_and_column($original_key);
310		-
311		- # Create parameter key infomations
312		- my $key_infos = [];
313		- for (my $i = 0; $i < $placeholder_count; $i++) {
314		- # Parameter key infomation
315		- my $key_info = {};
316		-
317		- # Original key
318		- $key_info->{original_key} = $original_key;
319		-
320		- # Table
321		- $key_info->{table} = $table;
322		-
323		- # Column name
324		- $key_info->{column} = $column;
325		-
326		- # Access keys
327		- my $access_keys = [];
328		- push @$access_keys, [$original_key, [$i]];
329		- push @$access_keys, [$table, $column, [$i]] if $table && $column;
330		- $key_info->{access_keys} = $access_keys;
331		-
332		- # Add parameter key infos
333		- push @$key_infos, $key_info;
334		- }
335		-
336		- return ($expand, $key_infos);
337		-}
338		-
339		-# Get table and column
340		-sub get_table_and_column {
341		- my $key = shift;
342		- $key \|\|= '';
343		-
344		- return ('', $key) unless $key =~ /\./;
345		-
346		- my ($table, $column) = split /\./, $key;
347		-
348		- return ($table, $column);
349		-}
350		-
351		-# Expand tag 'insert'
352		-sub expand_insert_tag {
353		- my ($tag_name, $tag_args) = @_;
354		- my $original_keys = $tag_args;
355		-
356		- # Insert key (k1, k2, k3, ..)
357		- my $insert_keys = '(';
358		-
359		- # placeholder (?, ?, ?, ..)
360		- my $place_holders = '(';
361		-
362		- foreach my $original_key (@$original_keys) {
363		- # Get table and column
364		- my ($table, $column) = get_table_and_column($original_key);
365		-
366		- # Join insert column
367		- $insert_keys .= "$column, ";
368		-
369		- # Join place holder
370		- $place_holders .= "?, ";
371		- }
372		-
373		- # Delete last ', '
374		- $insert_keys =~ s/, $//;
375		-
376		- # Close
377		- $insert_keys .= ')';
378		- $place_holders =~ s/, $//;
379		- $place_holders .= ')';
380		-
381		- # Expand tag
382		- my $expand = "$insert_keys values $place_holders";
383		-
384		- # Create parameter key infomations
385		- my $key_infos = [];
386		- foreach my $original_key (@$original_keys) {
387		- # Get table and clumn name
388		- my ($table, $column) = get_table_and_column($original_key);
389		-
390		- # Parameter key infomation
391		- my $key_info = {};
392		-
393		- # Original key
394		- $key_info->{original_key} = $original_key;
395		-
396		- # Table
397		- $key_info->{table} = $table;
398		-
399		- # Column name
400		- $key_info->{column} = $column;
401		-
402		- # Access keys
403		- my $access_keys = [];
404		- push @$access_keys, ['#insert', $original_key];
405		- push @$access_keys, ['#insert', $table, $column] if $table && $column;
406		- push @$access_keys, [$original_key];
407		- push @$access_keys, [$table, $column] if $table && $column;
408		- $key_info->{access_keys} = $access_keys;
409		-
410		- # Add parameter key infos
411		- push @$key_infos, $key_info;
412		- }
413		-
414		- return ($expand, $key_infos);
415		-}
416		-
417		-# Expand tag 'update'
418		-sub expand_update_tag {
419		- my ($tag_name, $tag_args) = @_;
420		- my $original_keys = $tag_args;
421		-
422		- # Expanded tag
423		- my $expand = 'set ';
424		-
425		- #
426		- foreach my $original_key (@$original_keys) {
427		- # Get table and clumn name
428		- my ($table, $column) = get_table_and_column($original_key);
429		-
430		- # Join key and placeholder
431		- $expand .= "$column = ?, ";
432		- }
433		-
434		- # Delete last ', '
435		- $expand =~ s/, $//;
436		-
437		- # Create parameter key infomations
438		- my $key_infos = [];
439		- foreach my $original_key (@$original_keys) {
440		- # Get table and clumn name
441		- my ($table, $column) = get_table_and_column($original_key);
442		-
443		- # Parameter key infomation
444		- my $key_info = {};
445		-
446		- # Original key
447		- $key_info->{original_key} = $original_key;
448		-
449		- # Table
450		- $key_info->{table} = $table;
451		-
452		- # Column name
453		- $key_info->{column} = $column;
454		-
455		- # Access keys
456		- my $access_keys = [];
457		- push @$access_keys, ['#update', $original_key];
458		- push @$access_keys, ['#update', $table, $column] if $table && $column;
459		- push @$access_keys, [$original_key];
460		- push @$access_keys, [$table, $column] if $table && $column;
461		- $key_info->{access_keys} = $access_keys;
462		-
463		- # Add parameter key infos
464		- push @$key_infos, $key_info;
465		- }
466		-
467		- return ($expand, $key_infos);
468		-}
469		-
470		-1;
471		-
472		-=head1 NAME
473		-
474		-DBIx::Custom::SQL::Template - Custamizable SQL Template for DBIx::Custom
475		-
476		-=head1 VERSION
477		-
478		-Version 0.0101
479		-
480		-=cut
481		-
482		-=head1 SYNOPSIS
483		-
484		- my $sql_tmpl = DBIx::Custom::SQL::Template->new;
485		-
486		- my $tmpl = "select from table {= k1} && {<> k2} \|\| {like k3}";
487		- my $param = {k1 => 1, k2 => 2, k3 => 3};
488		-
489		- my $query = $sql_template->create_query($tmpl);
490		-
491		-
492		- # Using query from DBIx::Custom
493		- use DBIx::Custom;
494		- my $dbi = DBI->new(
495		- data_source => $data_source,
496		- user => $user,
497		- password => $password,
498		- dbi_options => {PrintError => 0, RaiseError => 1}
499		- );
500		-
501		- $query = $dbi->create_query($tmpl); # This is SQL::Template create_query
502		- $dbi->query($query, $param);
503		-
504		-=head1 CLASS-OBJECT ACCESSORS
505		-
506		-Class-Object accessor is used from both object and class
507		-
508		- $class->$accessor # call from class
509		- $self->$accessor # call form object
510		-
511		-=head2 tag_processors
512		-
513		- # Set and get
514		- $self = $sql_tmpl->tag_processors($tag_processors);
515		- $tag_processors = $sql_tmpl->tag_processors;
516		-
517		- # Sample
518		- $sql_tmpl->tag_processors(
519		- '?' => \&expand_question,
520		- '=' => \&expand_equel
521		- );
522		-
523		-You can use add_tag_processor to add tag processor
524		-
525		-=head2 tag_start
526		-
527		- # Set and get
528		- $self = $sql_tmpl->tag_start($tag_start);
529		- $tag_start = $sql_tmpl->tag_start;
530		-
531		- # Sample
532		- $sql_tmpl->tag_start('{');
533		-
534		-Default is '{'
535		-
536		-=head2 tag_end
537		-
538		- # Set and get
539		- $self = $sql_tmpl->tag_start($tag_end);
540		- $tag_end = $sql_tmpl->tag_start;
541		-
542		- # Sample
543		- $sql_tmpl->tag_start('}');
544		-
545		-Default is '}'
546		-
547		-=head2 tag_syntax
548		-
549		- # Set and get
550		- $self = $sql_tmpl->tag_syntax($tag_syntax);
551		- $tag_syntax = $sql_tmpl->tag_syntax;
552		-
553		- # Sample
554		- $sql_tmpl->tag_syntax(
555		- "[Tag] [Expand]\n" .
556		- "{? name} ?\n" .
557		- "{= name} name = ?\n" .
558		- "{<> name} name <> ?\n"
559		- );
560		-
561		-=head1 METHODS
562		-
563		-=head2 create_query
564		-
565		- # Create SQL form SQL template
566		- $query = $sql_tmpl->create_query($tmpl);
567		-
568		- # Sample
569		- $query = $sql_tmpl->create_sql(
570		- "select * from table where {= title} && {like author} \|\| {<= price}")
571		-
572		- # Result
573		- $qeury->{sql} : "select * from table where title = ? && author like ? price <= ?;"
574		- $query->{key_infos} : [['title'], ['author'], ['price']]
575		-
576		- # Sample2 (with table name)
577		- ($sql, @bind_values) = $sql_tmpl->create_sql(
578		- "select * from table where {= table.title} && {like table.author}",
579		- {table => {title => 'Perl', author => '%Taro%'}}
580		- )
581		-
582		- # Result2
583		- $query->{sql} : "select * from table where table.title = ? && table.title like ?;"
584		- $query->{key_infos} :[ [['table.title'],['table', 'title']],
585		- [['table.author'],['table', 'author']] ]
586		-
587		-This method create query using by DBIx::Custom.
588		-query is two infomation
589		-
590		- 1.sql : SQL
591		- 2.key_infos : Parameter access key information
592		-
593		-=head2 add_tag_processor
594		-
595		-Add tag processor
596		-
597		- # Add
598		- $self = $sql_tmpl->add_tag_processor($tag_processor);
599		-
600		- # Sample
601		- $sql_tmpl->add_tag_processor(
602		- '?' => sub {
603		- my ($tag_name, $tag_args) = @_;
604		-
605		- my $key1 = $tag_args->[0];
606		- my $key2 = $tag_args->[1];
607		-
608		- my $key_infos = [];
609		-
610		- # Expand tag and create key informations
611		-
612		- # Return expand tags and key informations
613		- return ($expand, $key_infos);
614		- }
615		- );
616		-
617		-Tag processor recieve 2 argument
618		-
619		- 1. Tag name (?, =, <>, or etc)
620		- 2. Tag arguments (arg1 and arg2 in {tag_name arg1 arg2})
621		-
622		-Tag processor return 2 value
623		-
624		- 1. Expanded Tag (For exsample, '{= title}' is expanded to 'title = ?')
625		- 2. Key infomations
626		-
627		-You must be return expanded tag and key infomations.
628		-
629		-Key information is a little complex. so I will explan this in future.
630		-
631		-If you want to know more, Please see DBIx::Custom::SQL::Template source code.
632		-
633		-=head2 clone
634		-
635		- # Clone DBIx::Custom::SQL::Template object
636		- $clone = $self->clone;
637		-
638		-=head1 Available Tags
639		-
640		- # Available Tags
641		- [tag] [expand]
642		- {? name} ?
643		- {= name} name = ?
644		- {<> name} name <> ?
645		-
646		- {< name} name < ?
647		- {> name} name > ?
648		- {>= name} name >= ?
649		- {<= name} name <= ?
650		-
651		- {like name} name like ?
652		- {in name} name in [?, ?, ..]
653		-
654		- {insert} (key1, key2, key3) values (?, ?, ?)
655		- {update} set key1 = ?, key2 = ?, key3 = ?
656		-
657		- # Sample1
658		- $query = $sql_tmpl->create_sql(
659		- "insert into table {insert key1 key2}"
660		- );
661		- # Result1
662		- $sql : "insert into table (key1, key2) values (?, ?)"
663		-
664		-
665		- # Sample2
666		- $query = $sql_tmpl->create_sql(
667		- "update table {update key1 key2} where {= key3}"
668		- );
669		-
670		- # Result2
671		- $query->{sql} : "update table set key1 = ?, key2 = ? where key3 = ?;"
672		-
673		-=head1 AUTHOR
674		-
675		-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
676		-
677		-Github
678		-L<http://github.com/yuki-kimoto>
679		-L<http://github.com/yuki-kimoto/DBIx-Custom-SQL-Template>
680		-
681		-Please let know me bag if you find
682		-Please request me if you want to do something
683		-
684		-=head1 COPYRIGHT & LICENSE
685		-
686		-Copyright 2009 Yuki Kimoto, all rights reserved.
687		-
688		-This program is free software; you can redistribute it and/or modify it
689		-under the same terms as Perl itself.
690		-
691		-
692		-=cut
693		-
694		-1; # End of DBIx::Custom::SQL::Template

...	...	@@ -1,136 +0,0 @@
1		-package DBIx::Custom::SQLite;
2		-use base 'DBIx::Custom::Basic';
3		-
4		-use warnings;
5		-use strict;
6		-use Carp 'croak';
7		-
8		-my $class = __PACKAGE__;
9		-
10		-$class->add_format(
11		- datetime => $class->formats->{SQL99_datetime},
12		- date => $class->formats->{SQL99_date},
13		- time => $class->formats->{SQL99_time},
14		-);
15		-
16		-sub connect {
17		- my $self = shift;
18		-
19		- if (!$self->data_source && (my $database = $self->database)) {
20		- $self->data_source("dbi:SQLite:dbname=$database");
21		- }
22		-
23		- return $self->SUPER::connect;
24		-}
25		-
26		-sub connect_memory {
27		- my $self = shift;
28		-
29		- # Data source for memory database
30		- $self->data_source('dbi:SQLite:dbname=:memory:');
31		-
32		- # Already connected
33		- croak("Already connected") if $self->connected;
34		-
35		- # Connect
36		- $self->connect;
37		-
38		- return $self;
39		-}
40		-
41		-sub reconnect_memory {
42		- my $self = shift;
43		-
44		- # Data source for memory database
45		- $self->data_source('dbi:SQLite:dbname=:memory:');
46		-
47		- # Reconnect
48		- $self->reconnect;
49		-
50		- return $self;
51		-}
52		-
53		-
54		-=head1 NAME
55		-
56		-DBIx::Custom::SQLite - DBIx::Custom SQLite implementation
57		-
58		-=head1 Version
59		-
60		-Version 0.0201
61		-
62		-=head1 Synopsys
63		-
64		- use DBIx::Custom::SQLite;
65		-
66		- # New
67		- my $dbi = DBIx::Custom::SQLite->new(user => 'taro', $password => 'kliej&@K',
68		- database => 'sample.db');
69		-
70		- # Insert
71		- $dbi->insert('books', {title => 'perl', author => 'taro'});
72		-
73		- # Update
74		- # same as 'update books set (title = 'aaa', author = 'ken') where id = 5;
75		- $dbi->update('books', {title => 'aaa', author => 'ken'}, {id => 5});
76		-
77		- # Delete
78		- $dbi->delete('books', {author => 'taro'});
79		-
80		- # select * from books;
81		- $dbi->select('books');
82		-
83		- # select * from books where ahthor = 'taro';
84		- $dbi->select('books', {author => 'taro'});
85		-
86		- # select author, title from books where author = 'taro'
87		- $dbi->select('books', [qw/author title/], {author => 'taro'});
88		-
89		- # select author, title from books where author = 'taro' order by id limit 1;
90		- $dbi->select('books', [qw/author title/], {author => 'taro'},
91		- 'order by id limit 1');
92		-
93		-=head1 See DBIx::Custom and DBI::Custom::Basic documentation
94		-
95		-This class is L<DBIx::Custom::Basic> subclass.
96		-and L<DBIx::Custom::Basic> is L<DBIx::Custom> subclass
97		-
98		-You can use all methods of L<DBIx::Custom::Basic> and <DBIx::Custom>
99		-Please see L<DBIx::Custom::Basic> and <DBIx::Custom> documentation
100		-
101		-=head1 Object methods
102		-
103		-=head2 connect
104		-
105		-This override L<DBIx::Custom> connect.
106		-
107		- # Connect to database
108		- $dbi->connect;
109		-
110		-If database attribute is set, automatically data source is created and connect
111		-
112		-=head2 connect_memory
113		-
114		- # Connect memory database
115		- $self = $dbi->connect_memory;
116		-
117		-=head2 reconnect_memory
118		-
119		- # Reconnect memory database
120		- $self = $dbi->reconnect_memory;
121		-
122		-=head1 Author
123		-
124		-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
125		-
126		-Github L<http://github.com/yuki-kimoto>
127		-
128		-I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
129		-
130		-=head1 Copyright & lisence
131		-
132		-Copyright 2009 Yuki Kimoto, all rights reserved.
133		-
134		-This program is free software; you can redistribute it and/or modify it
135		-under the same terms as Perl itself.
136		-

...	...	@@ -1,599 +0,0 @@
1		-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2		-.\"
3		-.\" Standard preamble:
4		-.\" ========================================================================
5		-.de Sh \" Subsection heading
6		-.br
7		-.if t .Sp
8		-.ne 5
9		-.PP
10		-\fB\\$1\fR
11		-.PP
12		-..
13		-.de Sp \" Vertical space (when we can't use .PP)
14		-.if t .sp .5v
15		-.if n .sp
16		-..
17		-.de Vb \" Begin verbatim text
18		-.ft CW
19		-.nf
20		-.ne \\$1
21		-..
22		-.de Ve \" End verbatim text
23		-.ft R
24		-.fi
25		-..
26		-.\" Set up some character translations and predefined strings. \*(-- will
27		-.\" give an unbreakable dash, \(PI will give pi, \(L" will give a left
28		-.\" double quote, and \*(R" will give a right double quote. \| will give a
29		-.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to
30		-.\" do unbreakable dashes and therefore won't be available. \(C` and \(C'
31		-.\" expand to `' in nroff, nothing in troff, for use with C<>.
32		-.tr \(W-\|\(bv\(Tr
33		-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34		-.ie n \{\
35		-. ds -- \(*W-
36		-. ds PI pi
37		-. if (\n(.H=4u)&(1m=24u) .ds -- \(W\h'-12u'\(W\h'-12u'-\" diablo 10 pitch
38		-. if (\n(.H=4u)&(1m=20u) .ds -- \(W\h'-12u'\(W\h'-8u'-\" diablo 12 pitch
39		-. ds L" ""
40		-. ds R" ""
41		-. ds C` ""
42		-. ds C' ""
43		-'br\}
44		-.el\{\
45		-. ds -- \\|\(em\\|
46		-. ds PI \(*p
47		-. ds L" ``
48		-. ds R" ''
49		-'br\}
50		-.\"
51		-.\" If the F register is turned on, we'll generate index entries on stderr for
52		-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53		-.\" entries marked with X<> in POD. Of course, you'll have to process the
54		-.\" output yourself in some meaningful fashion.
55		-.if \nF \{\
56		-. de IX
57		-. tm Index:\\$1\t\\n%\t"\\$2"
58		-..
59		-. nr % 0
60		-. rr F
61		-.\}
62		-.\"
63		-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
64		-.\" way too many mistakes in technical documents.
65		-.hy 0
66		-.if n .na
67		-.\"
68		-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69		-.\" Fear. Run. Save yourself. No user-serviceable parts.
70		-. \" fudge factors for nroff and troff
71		-.if n \{\
72		-. ds #H 0
73		-. ds #V .8m
74		-. ds #F .3m
75		-. ds #[ \f1
76		-. ds #] \fP
77		-.\}
78		-.if t \{\
79		-. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80		-. ds #V .6m
81		-. ds #F 0
82		-. ds #[ \&
83		-. ds #] \&
84		-.\}
85		-. \" simple accents for nroff and troff
86		-.if n \{\
87		-. ds ' \&
88		-. ds ` \&
89		-. ds ^ \&
90		-. ds , \&
91		-. ds ~ ~
92		-. ds /
93		-.\}
94		-.if t \{\
95		-. ds ' \\k:\h'-(\\n(.wu8/10-\(#H)'\'\h"\|\\n:u"
96		-. ds ` \\k:\h'-(\\n(.wu8/10-\(#H)'\`\h'\|\\n:u'
97		-. ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'^\h'\|\\n:u'
98		-. ds , \\k:\h'-(\\n(.wu*8/10)',\h'\|\\n:u'
99		-. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'\|\\n:u'
100		-. ds / \\k:\h'-(\\n(.wu8/10-\(#H)'\z\(sl\h'\|\\n:u'
101		-.\}
102		-. \" troff and (daisy-wheel) nroff accents
103		-.ds : \\k:\h'-(\\n(.wu8/10-\(#H+.1m+\(#F)'\v'-\(#V'\z.\h'.2m+\(#F'.\h'\|\\n:u'\v'\(#V'
104		-.ds 8 \h'\(#H'\(b\h'-\*(#H'
105		-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\(#H)/2u'\v'-.3n'\(#[\z\(de\v'.3n'\h'\|\\n:u'\*(#]
106		-.ds d- \h'\(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\(#H'
107		-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'\|\\n:u'
108		-.ds th \(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u2/3)'\s-1o\s+1\*(#]
109		-.ds Th \(#[\s+2I\s-2\h'-\w'I'u3/5'\v'-.3m'o\v'.3m'\*(#]
110		-.ds ae a\h'-(\w'a'u*4/10)'e
111		-.ds Ae A\h'-(\w'A'u*4/10)'E
112		-. \" corrections for vroff
113		-.if v .ds ~ \\k:\h'-(\\n(.wu9/10-\(#H)'\s-2\u~\d\s+2\h'\|\\n:u'
114		-.if v .ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'\v'-.4m'^\v'.4m'\h'\|\\n:u'
115		-. \" for low resolution devices (crt and lpr)
116		-.if \n(.H>23 .if \n(.V>19 \
117		-\{\
118		-. ds : e
119		-. ds 8 ss
120		-. ds o a
121		-. ds d- d\h'-1'\(ga
122		-. ds D- D\h'-1'\(hy
123		-. ds th \o'bp'
124		-. ds Th \o'LP'
125		-. ds ae ae
126		-. ds Ae AE
127		-.\}
128		-.rm #[ #] #H #V #F C
129		-.\" ========================================================================
130		-.\"
131		-.IX Title "DBIx::Custom 3"
132		-.TH DBIx::Custom 3 "2009-11-16" "perl v5.8.8" "User Contributed Perl Documentation"
133		-.SH "NAME"
134		-DBIx::Custom \- Customizable simple DBI
135		-.SH "VERSION"
136		-.IX Header "VERSION"
137		-Version 0.0501
138		-.SH "CAUTION"
139		-.IX Header "CAUTION"
140		-This module is now experimental stage.
141		-.PP
142		-I want you to try this module
143		-because I want this module stable, and not to damage your \s-1DB\s0 data by this module bug.
144		-.PP
145		-Please tell me bug if you find
146		-.SH "SYNOPSIS"
147		-.IX Header "SYNOPSIS"
148		-.Vb 1
149		-\& my $dbi = DBIx::Custom->new;
150		-.Ve
151		-.PP
152		-.Vb 2
153		-\& my $query = $dbi->create_query($template);
154		-\& $dbi->execute($query);
155		-.Ve
156		-.SH "CLASS-OBJECT ACCESSORS"
157		-.IX Header "CLASS-OBJECT ACCESSORS"
158		-.Sh "user"
159		-.IX Subsection "user"
160		-.Vb 3
161		-\& # Set and get database user name
162		-\& $self = $dbi->user($user);
163		-\& $user = $dbi->user;
164		-.Ve
165		-.PP
166		-.Vb 2
167		-\& # Sample
168		-\& $dbi->user('taro');
169		-.Ve
170		-.Sh "password"
171		-.IX Subsection "password"
172		-.Vb 3
173		-\& # Set and get database password
174		-\& $self = $dbi->password($password);
175		-\& $password = $dbi->password;
176		-.Ve
177		-.PP
178		-.Vb 2
179		-\& # Sample
180		-\& $dbi->password('lkj&le`@s');
181		-.Ve
182		-.Sh "data_source"
183		-.IX Subsection "data_source"
184		-.Vb 3
185		-\& # Set and get database data source
186		-\& $self = $dbi->data_source($data_soruce);
187		-\& $data_source = $dbi->data_source;
188		-.Ve
189		-.PP
190		-.Vb 2
191		-\& # Sample(SQLite)
192		-\& $dbi->data_source(dbi:SQLite:dbname=$database);
193		-.Ve
194		-.PP
195		-.Vb 2
196		-\& # Sample(MySQL);
197		-\& $dbi->data_source("dbi:mysql:dbname=$database");
198		-.Ve
199		-.PP
200		-.Vb 2
201		-\& # Sample(PostgreSQL)
202		-\& $dbi->data_source("dbi:Pg:dbname=$database");
203		-.Ve
204		-.Sh "database"
205		-.IX Subsection "database"
206		-.Vb 3
207		-\& # Set and get database name
208		-\& $self = $dbi->database($database);
209		-\& $database = $dbi->database;
210		-.Ve
211		-.PP
212		-This method will be used in subclass connect method.
213		-.Sh "dbi_options"
214		-.IX Subsection "dbi_options"
215		-.Vb 3
216		-\& # Set and get DBI option
217		-\& $self = $dbi->dbi_options({$options => $value, ...});
218		-\& $dbi_options = $dbi->dbi_options;
219		-.Ve
220		-.PP
221		-.Vb 2
222		-\& # Sample
223		-\& $dbi->dbi_options({PrintError => 0, RaiseError => 1});
224		-.Ve
225		-.PP
226		-dbi_options is used when you connect database by using connect.
227		-.Sh "prepare"
228		-.IX Subsection "prepare"
229		-.Vb 1
230		-\& $sth = $dbi->prepare($sql);
231		-.Ve
232		-.PP
233		-This method is same as DBI::prepare
234		-.Sh "do"
235		-.IX Subsection "do"
236		-.Vb 1
237		-\& $dbi->do($sql, @bind_values);
238		-.Ve
239		-.PP
240		-This method is same as DBI::do
241		-.Sh "sql_template"
242		-.IX Subsection "sql_template"
243		-.Vb 3
244		-\& # Set and get SQL::Template object
245		-\& $self = $dbi->sql_template($sql_template);
246		-\& $sql_template = $dbi->sql_template;
247		-.Ve
248		-.PP
249		-.Vb 2
250		-\& # Sample
251		-\& $dbi->sql_template(DBI::Cutom::SQL::Template->new);
252		-.Ve
253		-.Sh "filters"
254		-.IX Subsection "filters"
255		-.Vb 3
256		-\& # Set and get filters
257		-\& $self = $dbi->filters($filters);
258		-\& $filters = $dbi->filters;
259		-.Ve
260		-.Sh "formats"
261		-.IX Subsection "formats"
262		-.Vb 3
263		-\& # Set and get formats
264		-\& $self = $dbi->formats($formats);
265		-\& $formats = $dbi->formats;
266		-.Ve
267		-.Sh "bind_filter"
268		-.IX Subsection "bind_filter"
269		-.Vb 3
270		-\& # Set and get binding filter
271		-\& $self = $dbi->bind_filter($bind_filter);
272		-\& $bind_filter = $dbi->bind_filter
273		-.Ve
274		-.PP
275		-.Vb 2
276		-\& # Sample
277		-\& $dbi->bind_filter($self->filters->{default_bind_filter});
278		-.Ve
279		-.PP
280		-you can get \s-1DBI\s0 database handle if you need.
281		-.Sh "fetch_filter"
282		-.IX Subsection "fetch_filter"
283		-.Vb 3
284		-\& # Set and get Fetch filter
285		-\& $self = $dbi->fetch_filter($fetch_filter);
286		-\& $fetch_filter = $dbi->fetch_filter;
287		-.Ve
288		-.PP
289		-.Vb 2
290		-\& # Sample
291		-\& $dbi->fetch_filter($self->filters->{default_fetch_filter});
292		-.Ve
293		-.Sh "no_bind_filters"
294		-.IX Subsection "no_bind_filters"
295		-.Vb 3
296		-\& # Set and get no filter keys when binding
297		-\& $self = $dbi->no_bind_filters($no_bind_filters);
298		-\& $no_bind_filters = $dbi->no_bind_filters;
299		-.Ve
300		-.Sh "no_fetch_filters"
301		-.IX Subsection "no_fetch_filters"
302		-.Vb 3
303		-\& # Set and get no filter keys when fetching
304		-\& $self = $dbi->no_fetch_filters($no_fetch_filters);
305		-\& $no_fetch_filters = $dbi->no_fetch_filters;
306		-.Ve
307		-.Sh "result_class"
308		-.IX Subsection "result_class"
309		-.Vb 3
310		-\& # Set and get resultset class
311		-\& $self = $dbi->result_class($result_class);
312		-\& $result_class = $dbi->result_class;
313		-.Ve
314		-.PP
315		-.Vb 2
316		-\& # Sample
317		-\& $dbi->result_class('DBIx::Custom::Result');
318		-.Ve
319		-.Sh "dbh"
320		-.IX Subsection "dbh"
321		-.Vb 2
322		-\& # Get database handle
323		-\& $dbh = $self->dbh;
324		-.Ve
325		-.SH "METHODS"
326		-.IX Header "METHODS"
327		-.Sh "connect"
328		-.IX Subsection "connect"
329		-.Vb 2
330		-\& # Connect to database
331		-\& $self = $dbi->connect;
332		-.Ve
333		-.PP
334		-.Vb 4
335		-\& # Sample
336		-\& $dbi = DBIx::Custom->new(user => 'taro', password => 'lji8(',
337		-\& data_soruce => "dbi:mysql:dbname=$database");
338		-\& $dbi->connect;
339		-.Ve
340		-.Sh "disconnect"
341		-.IX Subsection "disconnect"
342		-.Vb 2
343		-\& # Disconnect database
344		-\& $dbi->disconnect;
345		-.Ve
346		-.PP
347		-If database is already disconnected, this method do noting.
348		-.Sh "reconnect"
349		-.IX Subsection "reconnect"
350		-.Vb 2
351		-\& # Reconnect
352		-\& $dbi->reconnect;
353		-.Ve
354		-.Sh "connected"
355		-.IX Subsection "connected"
356		-.Vb 2
357		-\& # Check connected
358		-\& $dbi->connected
359		-.Ve
360		-.Sh "filter_off"
361		-.IX Subsection "filter_off"
362		-.Vb 2
363		-\& # bind_filter and fitch_filter off
364		-\& $self->filter_off;
365		-.Ve
366		-.PP
367		-This is equeal to
368		-.PP
369		-.Vb 2
370		-\& $self->bind_filter(undef);
371		-\& $self->fetch_filter(undef);
372		-.Ve
373		-.Sh "add_filter"
374		-.IX Subsection "add_filter"
375		-.Vb 3
376		-\& # Add filter (hash ref or hash can be recieve)
377		-\& $self = $dbi->add_filter({$filter_name => $filter, ...});
378		-\& $self = $dbi->add_filter($filetr_name => $filter, ...);
379		-.Ve
380		-.PP
381		-.Vb 19
382		-\& # Sample
383		-\& $dbi->add_filter(
384		-\& decode_utf8 => sub {
385		-\& my ($key, $value, $table, $column) = @_;
386		-\& return Encode::decode('UTF-8', $value);
387		-\& },
388		-\& datetime_to_string => sub {
389		-\& my ($key, $value, $table, $column) = @_;
390		-\& return $value->strftime('%Y-%m-%d %H:%M:%S')
391		-\& },
392		-\& default_bind_filter => sub {
393		-\& my ($key, $value, $table, $column) = @_;
394		-\& if (ref $value eq 'Time::Piece') {
395		-\& return $dbi->filters->{datetime_to_string}->($value);
396		-\& }
397		-\& else {
398		-\& return $dbi->filters->{decode_utf8}->($value);
399		-\& }
400		-\& },
401		-.Ve
402		-.PP
403		-.Vb 18
404		-\& encode_utf8 => sub {
405		-\& my ($key, $value) = @_;
406		-\& return Encode::encode('UTF-8', $value);
407		-\& },
408		-\& string_to_datetime => sub {
409		-\& my ($key, $value) = @_;
410		-\& return DateTime::Format::MySQL->parse_datetime($value);
411		-\& },
412		-\& default_fetch_filter => sub {
413		-\& my ($key, $value, $type, $sth, $i) = @_;
414		-\& if ($type eq 'DATETIME') {
415		-\& return $dbi->filters->{string_to_datetime}->($value);
416		-\& }
417		-\& else {
418		-\& return $dbi->filters->{encode_utf8}->($value);
419		-\& }
420		-\& }
421		-\& );
422		-.Ve
423		-.PP
424		-add_filter add filter to filters
425		-.Sh "add_format"
426		-.IX Subsection "add_format"
427		-.Vb 1
428		-\& $dbi->add_format(date => '%Y:%m:%d');
429		-.Ve
430		-.Sh "create_query"
431		-.IX Subsection "create_query"
432		-.Vb 2
433		-\& # Create Query object from SQL template
434		-\& my $query = $dbi->create_query($template);
435		-.Ve
436		-.Sh "execute"
437		-.IX Subsection "execute"
438		-.Vb 3
439		-\& # Parse SQL template and execute SQL
440		-\& $result = $dbi->query($query, $params);
441		-\& $result = $dbi->query($template, $params); # Shorcut
442		-.Ve
443		-.PP
444		-.Vb 3
445		-\& # Sample
446		-\& $result = $dbi->query("select * from authors where {= name} and {= age}",
447		-\& {author => 'taro', age => 19});
448		-.Ve
449		-.PP
450		-.Vb 3
451		-\& while (my @row = $result->fetch) {
452		-\& # do something
453		-\& }
454		-.Ve
455		-.PP
456		-See also DBIx::Custom::SQL::Template
457		-.Sh "run_transaction"
458		-.IX Subsection "run_transaction"
459		-.Vb 4
460		-\& # Run transaction
461		-\& $dbi->run_transaction(sub {
462		-\& # do something
463		-\& });
464		-.Ve
465		-.PP
466		-If transaction is success, commit is execute.
467		-If tranzation is died, rollback is execute.
468		-.Sh "insert"
469		-.IX Subsection "insert"
470		-.Vb 2
471		-\& # Insert
472		-\& $dbi->insert($table, $insert_values);
473		-.Ve
474		-.PP
475		-.Vb 2
476		-\& # Sample
477		-\& $dbi->insert('books', {title => 'Perl', author => 'Taro'});
478		-.Ve
479		-.Sh "update"
480		-.IX Subsection "update"
481		-.Vb 2
482		-\& # Update
483		-\& $dbi->update($table, $update_values, $where);
484		-.Ve
485		-.PP
486		-.Vb 2
487		-\& # Sample
488		-\& $dbi->update('books', {title => 'Perl', author => 'Taro'}, {id => 5});
489		-.Ve
490		-.Sh "update_all"
491		-.IX Subsection "update_all"
492		-.Vb 2
493		-\& # Update all rows
494		-\& $dbi->update($table, $updat_values);
495		-.Ve
496		-.Sh "delete"
497		-.IX Subsection "delete"
498		-.Vb 2
499		-\& # Delete
500		-\& $dbi->delete($table, $where);
501		-.Ve
502		-.PP
503		-.Vb 2
504		-\& # Sample
505		-\& $dbi->delete('Books', {id => 5});
506		-.Ve
507		-.Sh "delete_all"
508		-.IX Subsection "delete_all"
509		-.Vb 2
510		-\& # Delete all rows
511		-\& $dbi->delete_all($table);
512		-.Ve
513		-.Sh "last_insert_id"
514		-.IX Subsection "last_insert_id"
515		-.Vb 2
516		-\& # Get last insert id
517		-\& $last_insert_id = $dbi->last_insert_id;
518		-.Ve
519		-.PP
520		-This method is same as \s-1DBI\s0 last_insert_id;
521		-.Sh "select"
522		-.IX Subsection "select"
523		-.Vb 8
524		-\& # Select
525		-\& $dbi->select(
526		-\& $table, # must be string or array;
527		-\& [@$columns], # must be array reference. this is optional
528		-\& {%$where_params}, # must be hash reference. this is optional
529		-\& $append_statement, # must be string. this is optional
530		-\& $query_edit_callback # must be code reference. this is optional
531		-\& );
532		-.Ve
533		-.PP
534		-.Vb 13
535		-\& # Sample
536		-\& $dbi->select(
537		-\& 'Books',
538		-\& ['title', 'author'],
539		-\& {id => 1},
540		-\& "for update",
541		-\& sub {
542		-\& my $query = shift;
543		-\& $query->bind_filter(sub {
544		-\& # ...
545		-\& });
546		-\& }
547		-\& );
548		-.Ve
549		-.PP
550		-.Vb 7
551		-\& # The way to join multi tables
552		-\& $dbi->select(
553		-\& ['table1', 'table2'],
554		-\& ['table1.id as table1_id', 'title'],
555		-\& {table1.id => 1},
556		-\& "where table1.id = table2.id",
557		-\& );
558		-.Ve
559		-.SH "Class Accessors"
560		-.IX Header "Class Accessors"
561		-.Sh "query_cache_max"
562		-.IX Subsection "query_cache_max"
563		-.Vb 3
564		-\& # Max query cache count
565		-\& $class = $class->query_cache_max($query_cache_max);
566		-\& $query_cache_max = $class->query_cache_max;
567		-.Ve
568		-.PP
569		-.Vb 2
570		-\& # Sample
571		-\& DBIx::Custom->query_cache_max(50);
572		-.Ve
573		-.SH "CAUTION"
574		-.IX Header "CAUTION"
575		-DBIx::Custom have \s-1DIB\s0 object internal.
576		-This module is work well in the following \s-1DBI\s0 condition.
577		-.PP
578		-.Vb 2
579		-\& 1. AutoCommit is true
580		-\& 2. RaiseError is true
581		-.Ve
582		-.PP
583		-By default, Both AutoCommit and RaiseError is true.
584		-You must not change these mode not to damage your data.
585		-.PP
586		-If you change these mode,
587		-you cannot get correct error message,
588		-or run_transaction may fail.
589		-.SH "AUTHOR"
590		-.IX Header "AUTHOR"
591		-Yuki Kimoto, \f(CW\(C`<kimoto.yuki at gmail.com>\(C'\fR
592		-.PP
593		-Github <http://github.com/yuki\-kimoto>
594		-.SH "COPYRIGHT & LICENSE"
595		-.IX Header "COPYRIGHT & LICENSE"
596		-Copyright 2009 Yuki Kimoto, all rights reserved.
597		-.PP
598		-This program is free software; you can redistribute it and/or modify it
599		-under the same terms as Perl itself.

...	...	@@ -1,367 +0,0 @@
1		-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2		-.\"
3		-.\" Standard preamble:
4		-.\" ========================================================================
5		-.de Sh \" Subsection heading
6		-.br
7		-.if t .Sp
8		-.ne 5
9		-.PP
10		-\fB\\$1\fR
11		-.PP
12		-..
13		-.de Sp \" Vertical space (when we can't use .PP)
14		-.if t .sp .5v
15		-.if n .sp
16		-..
17		-.de Vb \" Begin verbatim text
18		-.ft CW
19		-.nf
20		-.ne \\$1
21		-..
22		-.de Ve \" End verbatim text
23		-.ft R
24		-.fi
25		-..
26		-.\" Set up some character translations and predefined strings. \*(-- will
27		-.\" give an unbreakable dash, \(PI will give pi, \(L" will give a left
28		-.\" double quote, and \*(R" will give a right double quote. \| will give a
29		-.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to
30		-.\" do unbreakable dashes and therefore won't be available. \(C` and \(C'
31		-.\" expand to `' in nroff, nothing in troff, for use with C<>.
32		-.tr \(W-\|\(bv\(Tr
33		-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34		-.ie n \{\
35		-. ds -- \(*W-
36		-. ds PI pi
37		-. if (\n(.H=4u)&(1m=24u) .ds -- \(W\h'-12u'\(W\h'-12u'-\" diablo 10 pitch
38		-. if (\n(.H=4u)&(1m=20u) .ds -- \(W\h'-12u'\(W\h'-8u'-\" diablo 12 pitch
39		-. ds L" ""
40		-. ds R" ""
41		-. ds C` ""
42		-. ds C' ""
43		-'br\}
44		-.el\{\
45		-. ds -- \\|\(em\\|
46		-. ds PI \(*p
47		-. ds L" ``
48		-. ds R" ''
49		-'br\}
50		-.\"
51		-.\" If the F register is turned on, we'll generate index entries on stderr for
52		-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53		-.\" entries marked with X<> in POD. Of course, you'll have to process the
54		-.\" output yourself in some meaningful fashion.
55		-.if \nF \{\
56		-. de IX
57		-. tm Index:\\$1\t\\n%\t"\\$2"
58		-..
59		-. nr % 0
60		-. rr F
61		-.\}
62		-.\"
63		-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
64		-.\" way too many mistakes in technical documents.
65		-.hy 0
66		-.if n .na
67		-.\"
68		-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69		-.\" Fear. Run. Save yourself. No user-serviceable parts.
70		-. \" fudge factors for nroff and troff
71		-.if n \{\
72		-. ds #H 0
73		-. ds #V .8m
74		-. ds #F .3m
75		-. ds #[ \f1
76		-. ds #] \fP
77		-.\}
78		-.if t \{\
79		-. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80		-. ds #V .6m
81		-. ds #F 0
82		-. ds #[ \&
83		-. ds #] \&
84		-.\}
85		-. \" simple accents for nroff and troff
86		-.if n \{\
87		-. ds ' \&
88		-. ds ` \&
89		-. ds ^ \&
90		-. ds , \&
91		-. ds ~ ~
92		-. ds /
93		-.\}
94		-.if t \{\
95		-. ds ' \\k:\h'-(\\n(.wu8/10-\(#H)'\'\h"\|\\n:u"
96		-. ds ` \\k:\h'-(\\n(.wu8/10-\(#H)'\`\h'\|\\n:u'
97		-. ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'^\h'\|\\n:u'
98		-. ds , \\k:\h'-(\\n(.wu*8/10)',\h'\|\\n:u'
99		-. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'\|\\n:u'
100		-. ds / \\k:\h'-(\\n(.wu8/10-\(#H)'\z\(sl\h'\|\\n:u'
101		-.\}
102		-. \" troff and (daisy-wheel) nroff accents
103		-.ds : \\k:\h'-(\\n(.wu8/10-\(#H+.1m+\(#F)'\v'-\(#V'\z.\h'.2m+\(#F'.\h'\|\\n:u'\v'\(#V'
104		-.ds 8 \h'\(#H'\(b\h'-\*(#H'
105		-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\(#H)/2u'\v'-.3n'\(#[\z\(de\v'.3n'\h'\|\\n:u'\*(#]
106		-.ds d- \h'\(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\(#H'
107		-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'\|\\n:u'
108		-.ds th \(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u2/3)'\s-1o\s+1\*(#]
109		-.ds Th \(#[\s+2I\s-2\h'-\w'I'u3/5'\v'-.3m'o\v'.3m'\*(#]
110		-.ds ae a\h'-(\w'a'u*4/10)'e
111		-.ds Ae A\h'-(\w'A'u*4/10)'E
112		-. \" corrections for vroff
113		-.if v .ds ~ \\k:\h'-(\\n(.wu9/10-\(#H)'\s-2\u~\d\s+2\h'\|\\n:u'
114		-.if v .ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'\v'-.4m'^\v'.4m'\h'\|\\n:u'
115		-. \" for low resolution devices (crt and lpr)
116		-.if \n(.H>23 .if \n(.V>19 \
117		-\{\
118		-. ds : e
119		-. ds 8 ss
120		-. ds o a
121		-. ds d- d\h'-1'\(ga
122		-. ds D- D\h'-1'\(hy
123		-. ds th \o'bp'
124		-. ds Th \o'LP'
125		-. ds ae ae
126		-. ds Ae AE
127		-.\}
128		-.rm #[ #] #H #V #F C
129		-.\" ========================================================================
130		-.\"
131		-.IX Title "DBIx::Custom::Result 3"
132		-.TH DBIx::Custom::Result 3 "2009-11-16" "perl v5.8.8" "User Contributed Perl Documentation"
133		-.SH "NAME"
134		-DBIx::Custom::Result \- Resultset for DBIx::Custom
135		-.SH "VERSION"
136		-.IX Header "VERSION"
137		-Version 0.0301
138		-.SH "SYNOPSIS"
139		-.IX Header "SYNOPSIS"
140		-.Vb 3
141		-\& # $result is DBIx::Custom::Result object
142		-\& my $dbi = DBIx::Custom->new;
143		-\& my $result = $dbi->query($sql_template, $param);
144		-.Ve
145		-.PP
146		-.Vb 3
147		-\& while (my ($val1, $val2) = $result->fetch) {
148		-\& # do something
149		-\& }
150		-.Ve
151		-.SH "OBJECT ACCESSORS"
152		-.IX Header "OBJECT ACCESSORS"
153		-.Sh "sth"
154		-.IX Subsection "sth"
155		-.Vb 3
156		-\& # Set and Get statement handle
157		-\& $self = $result->sth($sth);
158		-\& $sth = $reuslt->sth
159		-.Ve
160		-.PP
161		-Statement handle is automatically set by DBIx::Custom.
162		-so you do not set statement handle.
163		-.PP
164		-If you need statement handle, you can get statement handle by using this method.
165		-.Sh "fetch_filter"
166		-.IX Subsection "fetch_filter"
167		-.Vb 3
168		-\& # Set and Get fetch filter
169		-\& $self = $result->fetch_filter($sth);
170		-\& $fetch_filter = $result->fech_filter;
171		-.Ve
172		-.PP
173		-Statement handle is automatically set by DBIx::Custom.
174		-If you want to set your fetch filter, you set it.
175		-.Sh "no_fetch_filters"
176		-.IX Subsection "no_fetch_filters"
177		-.Vb 3
178		-\& # Set and Get no filter keys when fetching
179		-\& $self = $result->no_fetch_filters($no_fetch_filters);
180		-\& $no_fetch_filters = $result->no_fetch_filters;
181		-.Ve
182		-.SH "METHODS"
183		-.IX Header "METHODS"
184		-.Sh "fetch"
185		-.IX Subsection "fetch"
186		-.Vb 2
187		-\& # Fetch row as array reference (Scalar context)
188		-\& $row = $result->fetch;
189		-.Ve
190		-.PP
191		-.Vb 2
192		-\& # Fetch row as array (List context)
193		-\& @row = $result->fecth
194		-.Ve
195		-.PP
196		-.Vb 6
197		-\& # Sample
198		-\& while (my $row = $result->fetch) {
199		-\& # do something
200		-\& my $val1 = $row->[0];
201		-\& my $val2 = $row->[1];
202		-\& }
203		-.Ve
204		-.PP
205		-fetch method is fetch resultset and get row as array or array reference.
206		-.Sh "fetch_hash"
207		-.IX Subsection "fetch_hash"
208		-.Vb 2
209		-\& # Fetch row as hash reference (Scalar context)
210		-\& $row = $result->fetch_hash;
211		-.Ve
212		-.PP
213		-.Vb 2
214		-\& # Fetch row as hash (List context)
215		-\& %row = $result->fecth_hash
216		-.Ve
217		-.PP
218		-.Vb 6
219		-\& # Sample
220		-\& while (my $row = $result->fetch_hash) {
221		-\& # do something
222		-\& my $val1 = $row->{key1};
223		-\& my $val2 = $row->{key2};
224		-\& }
225		-.Ve
226		-.PP
227		-fetch_hash method is fetch resultset and get row as hash or hash reference.
228		-.Sh "fetch_first"
229		-.IX Subsection "fetch_first"
230		-.Vb 2
231		-\& # Fetch only first (Scalar context)
232		-\& $row = $result->fetch_first;
233		-.Ve
234		-.PP
235		-.Vb 2
236		-\& # Fetch only first (List context)
237		-\& @row = $result->fetch_first;
238		-.Ve
239		-.PP
240		-This method fetch only first and finish statement handle
241		-.Sh "fetch_hash_first"
242		-.IX Subsection "fetch_hash_first"
243		-.Vb 2
244		-\& # Fetch only first as hash (Scalar context)
245		-\& $row = $result->fetch_hash_first;
246		-.Ve
247		-.PP
248		-.Vb 2
249		-\& # Fetch only first as hash (Scalar context)
250		-\& @row = $result->fetch_hash_first;
251		-.Ve
252		-.PP
253		-This method fetch only first and finish statement handle
254		-.Sh "fetch_rows"
255		-.IX Subsection "fetch_rows"
256		-.Vb 2
257		-\& # Fetch multi rows (Scalar context)
258		-\& $rows = $result->fetch_rows($row_count);
259		-.Ve
260		-.PP
261		-.Vb 2
262		-\& # Fetch multi rows (List context)
263		-\& @rows = $result->fetch_rows($row_count);
264		-.Ve
265		-.PP
266		-.Vb 2
267		-\& # Sapmle
268		-\& $rows = $result->fetch_rows(10);
269		-.Ve
270		-.Sh "fetch_hash_rows"
271		-.IX Subsection "fetch_hash_rows"
272		-.Vb 2
273		-\& # Fetch multi rows as hash (Scalar context)
274		-\& $rows = $result->fetch_hash_rows($row_count);
275		-.Ve
276		-.PP
277		-.Vb 2
278		-\& # Fetch multi rows as hash (List context)
279		-\& @rows = $result->fetch_hash_rows($row_count);
280		-.Ve
281		-.PP
282		-.Vb 2
283		-\& # Sapmle
284		-\& $rows = $result->fetch_hash_rows(10);
285		-.Ve
286		-.Sh "fetch_all"
287		-.IX Subsection "fetch_all"
288		-.Vb 2
289		-\& # Fetch all row as array ref of array ref (Scalar context)
290		-\& $rows = $result->fetch_all;
291		-.Ve
292		-.PP
293		-.Vb 2
294		-\& # Fetch all row as array of array ref (List context)
295		-\& @rows = $result->fecth_all;
296		-.Ve
297		-.PP
298		-.Vb 4
299		-\& # Sample
300		-\& my $rows = $result->fetch_all;
301		-\& my $val0_0 = $rows->[0][0];
302		-\& my $val1_1 = $rows->[1][1];
303		-.Ve
304		-.PP
305		-fetch_all method is fetch resultset and get all rows as array or array reference.
306		-.Sh "fetch_hash_all"
307		-.IX Subsection "fetch_hash_all"
308		-.Vb 2
309		-\& # Fetch all row as array ref of hash ref (Scalar context)
310		-\& $rows = $result->fetch_hash_all;
311		-.Ve
312		-.PP
313		-.Vb 2
314		-\& # Fetch all row as array of hash ref (List context)
315		-\& @rows = $result->fecth_all_hash;
316		-.Ve
317		-.PP
318		-.Vb 4
319		-\& # Sample
320		-\& my $rows = $result->fetch_hash_all;
321		-\& my $val0_key1 = $rows->[0]{key1};
322		-\& my $val1_key2 = $rows->[1]{key2};
323		-.Ve
324		-.Sh "error"
325		-.IX Subsection "error"
326		-.Vb 3
327		-\& # Get error infomation
328		-\& $error_messege = $result->error;
329		-\& ($error_message, $error_number, $error_state) = $result->error;
330		-.Ve
331		-.PP
332		-You can get get information. This is crenspond to the following.
333		-.PP
334		-.Vb 3
335		-\& $error_message : $result->sth->errstr
336		-\& $error_number : $result->sth->err
337		-\& $error_state : $result->sth->state
338		-.Ve
339		-.Sh "finish"
340		-.IX Subsection "finish"
341		-.Vb 2
342		-\& # Finish statement handle
343		-\& $result->finish
344		-.Ve
345		-.PP
346		-.Vb 3
347		-\& # Sample
348		-\& my $row = $reuslt->fetch; # fetch only one row
349		-\& $result->finish
350		-.Ve
351		-.PP
352		-You can finish statement handle.This is equel to
353		-.PP
354		-.Vb 1
355		-\& $result->sth->finish;
356		-.Ve
357		-.SH "AUTHOR"
358		-.IX Header "AUTHOR"
359		-Yuki Kimoto, \f(CW\(C`<kimoto.yuki at gmail.com>\(C'\fR
360		-.PP
361		-Github <http://github.com/yuki\-kimoto>
362		-.SH "COPYRIGHT & LICENSE"
363		-.IX Header "COPYRIGHT & LICENSE"
364		-Copyright 2009 Yuki Kimoto, all rights reserved.
365		-.PP
366		-This program is free software; you can redistribute it and/or modify it
367		-under the same terms as Perl itself.

...	...	@@ -1,15 +0,0 @@
1		-#!perl -T
2		-
3		-use Test::More tests => 7;
4		-
5		-BEGIN {
6		- use_ok( 'DBIx::Custom' );
7		- use_ok( 'DBIx::Custom::Basic' );
8		- use_ok( 'DBIx::Custom::MySQL' );
9		- use_ok( 'DBIx::Custom::Query' );
10		- use_ok( 'DBIx::Custom::Result' );
11		- use_ok( 'DBIx::Custom::SQL::Template' );
12		- use_ok( 'DBIx::Custom::SQLite' );
13		-}
14		-
15		-diag( "Testing DBIx::Custom $DBIx::Custom::VERSION, Perl $], $^X" );

...	...	@@ -1,51 +0,0 @@
1		-#!perl -T
2		-
3		-use strict;
4		-use warnings;
5		-use Test::More tests => 3;
6		-
7		-sub not_in_file_ok {
8		- my ($filename, %regex) = @_;
9		- open( my $fh, '<', $filename )
10		- or die "couldn't open $filename for reading: $!";
11		-
12		- my %violated;
13		-
14		- while (my $line = <$fh>) {
15		- while (my ($desc, $regex) = each %regex) {
16		- if ($line =~ $regex) {
17		- push @{$violated{$desc}\|\|=[]}, $.;
18		- }
19		- }
20		- }
21		-
22		- if (%violated) {
23		- fail("$filename contains boilerplate text");
24		- diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
25		- } else {
26		- pass("$filename contains no boilerplate text");
27		- }
28		-}
29		-
30		-sub module_boilerplate_ok {
31		- my ($module) = @_;
32		- not_in_file_ok($module =>
33		- 'the great new $MODULENAME' => qr/ - The great new /,
34		- 'boilerplate description' => qr/Quick summary of what the module/,
35		- 'stub function definition' => qr/function[12]/,
36		- );
37		-}
38		-
39		-
40		- not_in_file_ok(README =>
41		- "The README is used..." => qr/The README is used/,
42		- "'version information here'" => qr/to provide version information/,
43		- );
44		-
45		- not_in_file_ok(Changes =>
46		- "placeholder date/time" => qr(Date/time)
47		- );
48		-
49		- module_boilerplate_ok('lib/DBIx/Custom.pm');
50		-
51		-

...	...	@@ -1,67 +0,0 @@
1		-use Test::More;
2		-use strict;
3		-use warnings;
4		-use utf8;
5		-use Encode qw/decode encode/;
6		-
7		-BEGIN {
8		- eval { require DBD::SQLite; 1 }
9		- or plan skip_all => 'DBD::SQLite required';
10		- eval { DBD::SQLite->VERSION >= 1 }
11		- or plan skip_all => 'DBD::SQLite >= 1.00 required';
12		-
13		- plan 'no_plan';
14		- use_ok('DBIx::Custom');
15		-}
16		-
17		-# Function for test name
18		-my $test;
19		-sub test {
20		- $test = shift;
21		-}
22		-
23		-# Constant varialbes for test
24		-my $CREATE_TABLE = {
25		- 0 => 'create table table1 (key1 char(255), key2 char(255));',
26		- 1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
27		- 2 => 'create table table2 (key1 char(255), key3 char(255));'
28		-};
29		-
30		-my $SELECT_TMPL = {
31		- 0 => 'select * from table1;'
32		-};
33		-
34		-my $DROP_TABLE = {
35		- 0 => 'drop table table1'
36		-};
37		-
38		-my $NEW_ARGS = {
39		- 0 => {data_source => 'dbi:SQLite:dbname=:memory:'}
40		-};
41		-
42		-# Variables for test
43		-my $dbi;
44		-my $decoded_str;
45		-my $encoded_str;
46		-my $array;
47		-
48		-use DBIx::Custom::Basic;
49		-
50		-test 'Filter';
51		-$dbi = DBIx::Custom::Basic->new($NEW_ARGS->{0});
52		-ok($dbi->filters->{encode_utf8}, "$test : exists default_bind_filter");
53		-ok($dbi->filters->{decode_utf8}, "$test : exists default_fetch_filter");
54		-
55		-$dbi->utf8_filter_on;
56		-is($dbi->bind_filter, $dbi->filters->{encode_utf8}, 'default bind filter');
57		-is($dbi->fetch_filter, $dbi->filters->{decode_utf8}, 'default fetch filter');
58		-
59		-$decoded_str = 'あ';
60		-$encoded_str = $dbi->bind_filter->($decoded_str);
61		-is($encoded_str, encode('UTF-8', $decoded_str), "$test : encode utf8");
62		-is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");
63		-
64		-$decoded_str = 'a';
65		-$encoded_str = $dbi->bind_filter->($decoded_str);
66		-is($encoded_str, encode('UTF-8', $decoded_str), "$test : upgrade and encode utf8");
67		-is($decoded_str, $dbi->fetch_filter->($encoded_str), "$test : fetch_filter");

...	...	@@ -1,36 +0,0 @@
1		-use Test::More;
2		-use strict;
3		-use warnings;
4		-
5		-# user password database
6		-our ($USER, $PASSWORD, $DATABASE) = connect_info();
7		-
8		-plan skip_all => 'private MySQL test' unless $USER;
9		-
10		-plan 'no_plan';
11		-
12		-use DBIx::Custom;
13		-use Scalar::Util 'blessed';
14		-{
15		- my $dbi = DBIx::Custom->new(
16		- user => $USER,
17		- password => $PASSWORD,
18		- data_source => "dbi:mysql:dbname=$DATABASE"
19		- );
20		- $dbi->connect;
21		-
22		- ok(blessed $dbi->dbh);
23		- can_ok($dbi->dbh, qw/prepare/);
24		-}
25		-
26		-sub connect_info {
27		- my $file = 'password.tmp';
28		- open my $fh, '<', $file
29		- or return;
30		-
31		- my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);
32		-
33		- close $fh;
34		-
35		- return ($user, $password, $database);
36		-}

...	...	@@ -1,220 +0,0 @@
1		-use Test::More 'no_plan';
2		-use strict;
3		-use warnings;
4		-
5		-use DBIx::Custom;
6		-use DBIx::Custom::SQL::Template;
7		-
8		-# Function for test name
9		-my $test;
10		-sub test {
11		- $test = shift;
12		-}
13		-
14		-# Variables for test
15		-our $SQL_TMPL = {
16		- 0 => DBIx::Custom::SQL::Template->new->tag_start(0),
17		- 1 => DBIx::Custom::SQL::Template->new->tag_start(1),
18		- 2 => DBIx::Custom::SQL::Template->new->tag_start(2)
19		-};
20		-my $dbi;
21		-
22		-
23		-test 'Constructor';
24		-$dbi = DBIx::Custom->new(
25		- user => 'a',
26		- database => 'a',
27		- password => 'b',
28		- data_source => 'c',
29		- dbi_options => {d => 1, e => 2},
30		- filters => {
31		- f => 3,
32		- },
33		- bind_filter => 'f',
34		- fetch_filter => 'g',
35		- result_class => 'g',
36		- sql_template => $SQL_TMPL->{0},
37		-);
38		-is_deeply($dbi,{user => 'a', database => 'a', password => 'b', data_source => 'c',
39		- dbi_options => {d => 1, e => 2}, filters => {f => 3}, bind_filter => 'f',
40		- fetch_filter => 'g', result_class => 'g',
41		- sql_template => $SQL_TMPL->{0}}, $test);
42		-isa_ok($dbi, 'DBIx::Custom');
43		-
44		-
45		-test 'Sub class constructor';
46		-{
47		- package DBIx::Custom::T1;
48		- use base 'DBIx::Custom';
49		-
50		- __PACKAGE__
51		- ->user('a')
52		- ->database('a')
53		- ->password('b')
54		- ->data_source('c')
55		- ->dbi_options({d => 1, e => 2})
56		- ->filters(
57		- f => 3
58		- )
59		- ->formats(
60		- f => 3
61		- )
62		- ->bind_filter('f')
63		- ->fetch_filter('g')
64		- ->result_class('DBIx::Custom::Result')
65		- ->sql_template($SQL_TMPL->{0})
66		- ;
67		-}
68		-$dbi = DBIx::Custom::T1->new(
69		- user => 'ao',
70		- database => 'ao',
71		- password => 'bo',
72		- data_source => 'co',
73		- dbi_options => {do => 10, eo => 20},
74		- filters => {
75		- fo => 30,
76		- },
77		- formats => {
78		- fo => 30,
79		- },
80		- bind_filter => 'fo',
81		- fetch_filter => 'go',
82		- result_class => 'ho',
83		- sql_template => $SQL_TMPL->{0},
84		-);
85		-is($dbi->user, 'ao', "$test : user");
86		-is($dbi->database, 'ao', "$test : database");
87		-is($dbi->password, 'bo', "$test : passowr");
88		-is($dbi->data_source, 'co', "$test : data_source");
89		-is_deeply($dbi->dbi_options, {do => 10, eo => 20}, "$test : dbi_options");
90		-is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
91		-is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
92		-is($dbi->bind_filter, 'fo', "$test : bind_filter");
93		-is($dbi->fetch_filter, 'go', "$test : fetch_filter");
94		-is($dbi->result_class, 'ho', "$test : result_class");
95		-is($dbi->sql_template->tag_start, 0, "$test : sql_template");
96		-isa_ok($dbi, 'DBIx::Custom::T1');
97		-
98		-test 'Sub class constructor default';
99		-$dbi = DBIx::Custom::T1->new;
100		-is($dbi->user, 'a', "$test : user");
101		-is($dbi->database, 'a', "$test : database");
102		-is($dbi->password, 'b', "$test : password");
103		-is($dbi->data_source, 'c', "$test : data_source");
104		-is_deeply($dbi->dbi_options, {d => 1, e => 2}, "$test : dbi_options");
105		-is_deeply({$dbi->filters}, {f => 3}, "$test : filters");
106		-is_deeply({$dbi->formats}, {f => 3}, "$test : formats");
107		-is($dbi->bind_filter, 'f', "$test : bind_filter");
108		-is($dbi->fetch_filter, 'g', "$test : fetch_filter");
109		-is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");
110		-is($dbi->sql_template->tag_start, 0, "$test : sql_template");
111		-isa_ok($dbi, 'DBIx::Custom::T1');
112		-
113		-
114		-test 'Sub sub class constructor default';
115		-{
116		- package DBIx::Custom::T1_2;
117		- use base 'DBIx::Custom::T1';
118		-}
119		-$dbi = DBIx::Custom::T1_2->new;
120		-is($dbi->user, 'a', "$test : user");
121		-is($dbi->database, 'a', "$test : database");
122		-is($dbi->password, 'b', "$test : passowrd");
123		-is($dbi->data_source, 'c', "$test : data_source");
124		-is_deeply($dbi->dbi_options, {d => 1, e => 2}, "$test : dbi_options");
125		-is_deeply(scalar $dbi->filters, {f => 3}, "$test : filters");
126		-is_deeply(scalar $dbi->formats, {f => 3}, "$test : formats");
127		-is($dbi->bind_filter, 'f', "$test : bind_filter");
128		-is($dbi->fetch_filter, 'g', "$test : fetch_filter");
129		-is($dbi->result_class, 'DBIx::Custom::Result', "$test : result_class");
130		-is($dbi->sql_template->tag_start, 0, "$test sql_template");
131		-isa_ok($dbi, 'DBIx::Custom::T1_2');
132		-
133		-
134		-test 'Customized sub class constructor default';
135		-{
136		- package DBIx::Custom::T1_3;
137		- use base 'DBIx::Custom::T1';
138		-
139		- __PACKAGE__
140		- ->user('ao')
141		- ->database('ao')
142		- ->password('bo')
143		- ->data_source('co')
144		- ->dbi_options({do => 10, eo => 20})
145		- ->filters(
146		- fo => 30
147		- )
148		- ->formats(
149		- fo => 30
150		- )
151		- ->bind_filter('fo')
152		- ->fetch_filter('go')
153		- ->result_class('ho')
154		- ->sql_template($SQL_TMPL->{1})
155		- ;
156		-}
157		-$dbi = DBIx::Custom::T1_3->new;
158		-is($dbi->user, 'ao', "$test : user");
159		-is($dbi->database, 'ao', "$test : database");
160		-is($dbi->password, 'bo', "$test : password");
161		-is($dbi->data_source, 'co', "$test : data_source");
162		-is_deeply($dbi->dbi_options, {do => 10, eo => 20}, "$test : dbi_options");
163		-is_deeply(scalar $dbi->filters, {fo => 30}, "$test : filters");
164		-is_deeply(scalar $dbi->formats, {fo => 30}, "$test : formats");
165		-is($dbi->bind_filter, 'fo', "$test : bind_filter");
166		-is($dbi->fetch_filter, 'go', "$test : fetch_filter");
167		-is($dbi->result_class, 'ho', "$test : result_class");
168		-is($dbi->sql_template->tag_start, 1, "$test : sql_template");
169		-isa_ok($dbi, 'DBIx::Custom::T1_3');
170		-
171		-
172		-test 'Customized sub class constructor';
173		-$dbi = DBIx::Custom::T1_3->new(
174		- user => 'a',
175		- database => 'a',
176		- password => 'b',
177		- data_source => 'c',
178		- dbi_options => {d => 1, e => 2},
179		- filters => {
180		- f => 3,
181		- },
182		- formats => {
183		- f => 3,
184		- },
185		- bind_filter => 'f',
186		- fetch_filter => 'g',
187		- result_class => 'h',
188		- sql_template => $SQL_TMPL->{2},
189		-);
190		-is($dbi->user, 'a', "$test : user");
191		-is($dbi->database, 'a', "$test : database");
192		-is($dbi->password, 'b', "$test : password");
193		-is($dbi->data_source, 'c', "$test : data_source");
194		-is_deeply($dbi->dbi_options, {d => 1, e => 2}, "$test : dbi_options");
195		-is_deeply({$dbi->filters}, {f => 3}, "$test : filters");
196		-is_deeply({$dbi->formats}, {f => 3}, "$test : formats");
197		-is($dbi->bind_filter, 'f', "$test : bind_filter");
198		-is($dbi->fetch_filter, 'g', "$test : fetch_filter");
199		-is($dbi->result_class, 'h', "$test : result_class");
200		-is($dbi->sql_template->tag_start, 2, "$test : sql_template");
201		-isa_ok($dbi, 'DBIx::Custom');
202		-
203		-
204		-test 'add_filters';
205		-$dbi = DBIx::Custom->new;
206		-$dbi->add_filter(a => sub {1});
207		-is($dbi->filters->{a}->(), 1, $test);
208		-
209		-test 'add_formats';
210		-$dbi = DBIx::Custom->new;
211		-$dbi->add_format(a => sub {1});
212		-is($dbi->formats->{a}->(), 1, $test);
213		-
214		-test 'filter_off';
215		-$dbi = DBIx::Custom->new;
216		-$dbi->bind_filter('a');
217		-$dbi->fetch_filter('b');
218		-$dbi->filter_off;
219		-ok(!$dbi->bind_filter, "$test : bind_filter off");
220		-ok(!$dbi->fetch_filter, "$test : fetch_filter off");

...	...	@@ -1,47 +0,0 @@
1		-use Test::More;
2		-use strict;
3		-use warnings;
4		-
5		-# user password database
6		-our ($USER, $PASSWORD, $DATABASE) = connect_info();
7		-
8		-plan skip_all => 'private MySQL test' unless $USER;
9		-
10		-plan 'no_plan';
11		-
12		-# Function for test name
13		-my $test;
14		-sub test {
15		- $test = shift;
16		-}
17		-
18		-
19		-# Functions for tests
20		-sub connect_info {
21		- my $file = 'password.tmp';
22		- open my $fh, '<', $file
23		- or return;
24		-
25		- my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);
26		-
27		- close $fh;
28		-
29		- return ($user, $password, $database);
30		-}
31		-
32		-
33		-# Constat variables for tests
34		-my $CLASS = 'DBIx::Custom::MySQL';
35		-
36		-# Varialbes for tests
37		-my $dbi;
38		-
39		-use DBIx::Custom::MySQL;
40		-
41		-test 'connect';
42		-$dbi = $CLASS->new(user => $USER, password => $PASSWORD,
43		- database => $DATABASE);
44		-$dbi->connect;
45		-is(ref $dbi->dbh, 'DBI::db', $test);
46		-
47		-

...	...	@@ -1,85 +0,0 @@
1		-use Test::More;
2		-use strict;
3		-use warnings;
4		-
5		-BEGIN {
6		- eval { require Time::Piece; 1 }
7		- or plan skip_all => 'Time::Piece required';
8		-
9		- eval { Time::Piece->VERSION >= 1.15 }
10		- or plan skip_all => 'Time::Piece >= 1.15 requred';
11		-
12		- plan 'no_plan';
13		- use_ok('DBIx::Custom');
14		-}
15		-
16		-# Function for test name
17		-my $test;
18		-sub test {
19		- $test = shift;
20		-}
21		-
22		-# Varialbe for tests
23		-
24		-my $format;
25		-my $data;
26		-my $timepiece;
27		-my $dbi;
28		-
29		-use DBIx::Custom::MySQL;
30		-
31		-
32		-test 'SQL99 format';
33		-$dbi = DBIx::Custom::MySQL->new;
34		-$data = '2009-01-02 03:04:05';
35		-$format = $dbi->formats->{'SQL99_datetime'};
36		-$timepiece = Time::Piece->strptime($data, $format);
37		-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
38		-is($timepiece->strftime('%T'), '03:04:05', "$test : datetime time");
39		-
40		-$data = '2009-01-02';
41		-$format = $dbi->formats->{'SQL99_date'};
42		-$timepiece = Time::Piece->strptime($data, $format);
43		-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
44		-
45		-$data = '03:04:05';
46		-$format = $dbi->formats->{'SQL99_time'};
47		-$timepiece = Time::Piece->strptime($data, $format);
48		-is($timepiece->strftime('%T'), '03:04:05', "$test : time");
49		-
50		-
51		-test 'ISO-8601 format';
52		-$data = '2009-01-02T03:04:05';
53		-$format = $dbi->formats->{'ISO-8601_datetime'};
54		-$timepiece = Time::Piece->strptime($data, $format);
55		-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
56		-is($timepiece->strftime('%T'), '03:04:05', "$test : datetime time");
57		-
58		-$data = '2009-01-02';
59		-$format = $dbi->formats->{'ISO-8601_date'};
60		-$timepiece = Time::Piece->strptime($data, $format);
61		-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
62		-
63		-$data = '03:04:05';
64		-$format = $dbi->formats->{'ISO-8601_time'};
65		-$timepiece = Time::Piece->strptime($data, $format);
66		-is($timepiece->strftime('%T'), '03:04:05', "$test : time");
67		-
68		-
69		-test 'default format';
70		-$data = '2009-01-02 03:04:05';
71		-$format = $dbi->formats->{'datetime'};
72		-$timepiece = Time::Piece->strptime($data, $format);
73		-is($timepiece->strftime('%F'), '2009-01-02', "$test : datetime date");
74		-is($timepiece->strftime('%T'), '03:04:05', "$test : datetime time");
75		-
76		-$data = '2009-01-02';
77		-$format = $dbi->formats->{'date'};
78		-$timepiece = Time::Piece->strptime($data, $format);
79		-is($timepiece->strftime('%F'), '2009-01-02', "$test : date");
80		-
81		-$data = '03:04:05';
82		-$format = $dbi->formats->{'time'};
83		-$timepiece = Time::Piece->strptime($data, $format);
84		-is($timepiece->strftime('%T'), '03:04:05', "$test : time");
85		-

...	...	@@ -1,37 +0,0 @@
1		-use Test::More 'no_plan';
2		-
3		-use strict;
4		-use warnings;
5		-use DBIx::Custom::Query;
6		-
7		-# Function for test name
8		-my $test;
9		-sub test{
10		- $test = shift;
11		-}
12		-
13		-# Variables for test
14		-my $query;
15		-
16		-test 'Accessors';
17		-$query = DBIx::Custom::Query->new(
18		- sql => 'a',
19		- key_infos => 'b',
20		- bind_filter => 'c',
21		- no_bind_filters => [qw/d e/],
22		- sth => 'e',
23		- fetch_filter => 'f',
24		- no_fetch_filters => [qw/g h/],
25		-);
26		-
27		-is($query->sql, 'a', "$test : sql");
28		-is($query->key_infos, 'b', "$test : key_infos ");
29		-is($query->bind_filter, 'c', "$test : bind_filter");
30		-is_deeply(scalar $query->no_bind_filters, [qw/d e/], "$test : no_bind_filters");
31		-is_deeply(scalar $query->_no_bind_filters_map, {d => 1, e => 1}, "$test : _no_bind_filters_map");
32		-is_deeply(scalar $query->no_fetch_filters, [qw/g h/], "$test : no_fetch_filters");
33		-is($query->sth, 'e', "$test : sth");
34		-
35		-$query->no_bind_filters(undef);
36		-is_deeply(scalar $query->_no_bind_filters_map, {}, "$test _no_bind_filters_map undef value");
37		-

...	...	@@ -1,257 +0,0 @@
1		-use Test::More;
2		-use strict;
3		-use warnings;
4		-use DBI;
5		-
6		-BEGIN {
7		- eval { require DBD::SQLite; 1 }
8		- or plan skip_all => 'DBD::SQLite required';
9		- eval { DBD::SQLite->VERSION >= 1 }
10		- or plan skip_all => 'DBD::SQLite >= 1.00 required';
11		-
12		- plan 'no_plan';
13		- use_ok('DBIx::Custom::Result');
14		-}
15		-
16		-my $test;
17		-sub test {
18		- $test = shift;
19		-}
20		-
21		-sub query {
22		- my ($dbh, $sql) = @_;
23		- my $sth = $dbh->prepare($sql);
24		- $sth->execute;
25		- return DBIx::Custom::Result->new(sth => $sth);
26		-}
27		-
28		-my $dbh;
29		-my $sql;
30		-my $sth;
31		-my @row;
32		-my $row;
33		-my @rows;
34		-my $rows;
35		-my $result;
36		-my $fetch_filter;
37		-my @error;
38		-my $error;
39		-
40		-$dbh = DBI->connect('dbi:SQLite:dbname=:memory:', undef, undef, {PrintError => 0, RaiseError => 1});
41		-$dbh->do("create table table1 (key1 char(255), key2 char(255));");
42		-$dbh->do("insert into table1 (key1, key2) values ('1', '2');");
43		-$dbh->do("insert into table1 (key1, key2) values ('3', '4');");
44		-
45		-$sql = "select key1, key2 from table1";
46		-
47		-test 'fetch scalar context';
48		-$result = query($dbh, $sql);
49		-@rows = ();
50		-while (my $row = $result->fetch) {
51		- push @rows, [@$row];
52		-}
53		-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
54		-
55		-
56		-test 'fetch list context';
57		-$result = query($dbh, $sql);
58		-@rows = ();
59		-while (my @row = $result->fetch) {
60		- push @rows, [@row];
61		-}
62		-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
63		-
64		-test 'fetch_hash scalar context';
65		-$result = query($dbh, $sql);
66		-@rows = ();
67		-while (my $row = $result->fetch_hash) {
68		- push @rows, {%$row};
69		-}
70		-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
71		-
72		-
73		-test 'fetch hash list context';
74		-$result = query($dbh, $sql);
75		-@rows = ();
76		-while (my %row = $result->fetch_hash) {
77		- push @rows, {%row};
78		-}
79		-is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], $test);
80		-
81		-
82		-test 'fetch_first';
83		-$result = query($dbh, $sql);
84		-$row = $result->fetch_first;
85		-is_deeply($row, [1, 2], "$test : row");
86		-$row = $result->fetch;
87		-ok(!$row, "$test : finished");
88		-
89		-
90		-test 'fetch_first list context';
91		-$result = query($dbh, $sql);
92		-@row = $result->fetch_first;
93		-is_deeply([@row], [1, 2], "$test : row");
94		-@row = $result->fetch;
95		-ok(!@row, "$test : finished");
96		-
97		-
98		-test 'fetch_hash_first';
99		-$result = query($dbh, $sql);
100		-$row = $result->fetch_hash_first;
101		-is_deeply($row, {key1 => 1, key2 => 2}, "$test : row");
102		-$row = $result->fetch_hash;
103		-ok(!$row, "$test : finished");
104		-
105		-
106		-test 'fetch_hash_first list context';
107		-$result = query($dbh, $sql);
108		-@row = $result->fetch_hash_first;
109		-is_deeply({@row}, {key1 => 1, key2 => 2}, "$test : row");
110		-@row = $result->fetch_hash;
111		-ok(!@row, "$test : finished");
112		-
113		-
114		-test 'fetch_rows';
115		-$dbh->do("insert into table1 (key1, key2) values ('5', '6');");
116		-$dbh->do("insert into table1 (key1, key2) values ('7', '8');");
117		-$dbh->do("insert into table1 (key1, key2) values ('9', '10');");
118		-$result = query($dbh, $sql);
119		-$rows = $result->fetch_rows(2);
120		-is_deeply($rows, [[1, 2],
121		- [3, 4]], "$test : fetch_rows first");
122		-$rows = $result->fetch_rows(2);
123		-is_deeply($rows, [[5, 6],
124		- [7, 8]], "$test : fetch_rows secound");
125		-$rows = $result->fetch_rows(2);
126		-is_deeply($rows, [[9, 10]], "$test : fetch_rows third");
127		-$rows = $result->fetch_rows(2);
128		-ok(!$rows);
129		-
130		-
131		-test 'fetch_rows list context';
132		-$result = query($dbh, $sql);
133		-@rows = $result->fetch_rows(2);
134		-is_deeply([@rows], [[1, 2],
135		- [3, 4]], "$test : fetch_rows first");
136		-@rows = $result->fetch_rows(2);
137		-is_deeply([@rows], [[5, 6],
138		- [7, 8]], "$test : fetch_rows secound");
139		-@rows = $result->fetch_rows(2);
140		-is_deeply([@rows], [[9, 10]], "$test : fetch_rows third");
141		-@rows = $result->fetch_rows(2);
142		-ok(!@rows);
143		-
144		-
145		-test 'fetch_rows error';
146		-$result = query($dbh, $sql);
147		-eval {$result->fetch_rows};
148		-like($@, qr/Row count must be specified/, "$test : Not specified row count");
149		-
150		-
151		-test 'fetch_hash_rows';
152		-$result = query($dbh, $sql);
153		-$rows = $result->fetch_hash_rows(2);
154		-is_deeply($rows, [{key1 => 1, key2 => 2},
155		- {key1 => 3, key2 => 4}], "$test : fetch_rows first");
156		-$rows = $result->fetch_hash_rows(2);
157		-is_deeply($rows, [{key1 => 5, key2 => 6},
158		- {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
159		-$rows = $result->fetch_hash_rows(2);
160		-is_deeply($rows, [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
161		-$rows = $result->fetch_hash_rows(2);
162		-ok(!$rows);
163		-
164		-
165		-test 'fetch_rows list context';
166		-$result = query($dbh, $sql);
167		-@rows = $result->fetch_hash_rows(2);
168		-is_deeply([@rows], [{key1 => 1, key2 => 2},
169		- {key1 => 3, key2 => 4}], "$test : fetch_rows first");
170		-@rows = $result->fetch_hash_rows(2);
171		-is_deeply([@rows], [{key1 => 5, key2 => 6},
172		- {key1 => 7, key2 => 8}], "$test : fetch_rows secound");
173		-@rows = $result->fetch_hash_rows(2);
174		-is_deeply([@rows], [{key1 => 9, key2 => 10}], "$test : fetch_rows third");
175		-@rows = $result->fetch_hash_rows(2);
176		-ok(!@rows);
177		-$dbh->do("delete from table1 where key1 = 5 or key1 = 7 or key1 = 9");
178		-
179		-
180		-test 'fetch_rows error';
181		-$result = query($dbh, $sql);
182		-eval {$result->fetch_hash_rows};
183		-like($@, qr/Row count must be specified/, "$test : Not specified row count");
184		-
185		-
186		-test 'fetch_all';
187		-$result = query($dbh, $sql);
188		-$rows = $result->fetch_all;
189		-is_deeply($rows, [[1, 2], [3, 4]], $test);
190		-
191		-test 'fetch_all list context';
192		-$result = query($dbh, $sql);
193		-@rows = $result->fetch_all;
194		-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
195		-
196		-
197		-test 'fetch_hash_all';
198		-$result = query($dbh, $sql);
199		-@rows = $result->fetch_hash_all;
200		-is_deeply($rows, [[1, 2], [3, 4]], $test);
201		-
202		-
203		-test 'fetch_hash_all list context';
204		-$result = query($dbh, $sql);
205		-@rows = $result->fetch_all;
206		-is_deeply(\@rows, [[1, 2], [3, 4]], $test);
207		-
208		-
209		-test 'fetch filter';
210		-$fetch_filter = sub {
211		- my ($value, $key, $type, $sth, $i) = @_;
212		- if ($key eq 'key1' && $value == 1 && $type =~ /char/i && $i == 0 && $sth->{TYPE}->[$i] eq $type) {
213		- return $value * 3;
214		- }
215		- return $value;
216		-};
217		-
218		-$result = query($dbh, $sql);
219		-$result->fetch_filter($fetch_filter);
220		-$rows = $result->fetch_all;
221		-is_deeply($rows, [[3, 2], [3, 4]], "$test array");
222		-
223		-$result = query($dbh, $sql);
224		-$result->fetch_filter($fetch_filter);
225		-$rows = $result->fetch_hash_all;
226		-is_deeply($rows, [{key1 => 3, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash");
227		-
228		-$result = query($dbh, $sql);
229		-$result->no_fetch_filters(['key1']);
230		-$rows = $result->fetch_all;
231		-is_deeply($rows, [[1, 2], [3, 4]], "$test array no filter keys");
232		-
233		-$result = query($dbh, $sql);
234		-$result->no_fetch_filters(['key1']);
235		-$rows = $result->fetch_hash_all;
236		-is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test hash no filter keys");
237		-
238		-
239		-test 'finish';
240		-$result = query($dbh, $sql);
241		-$result->fetch;
242		-$result->finish;
243		-ok(!$result->fetch, $test);
244		-
245		-test 'error'; # Cannot real test
246		-$result = query($dbh, $sql);
247		-$sth = $result->sth;
248		-
249		-@error = $result->error;
250		-is(scalar @error, 3, "$test list context count");
251		-is($error[0], $sth->errstr, "$test list context errstr");
252		-is($error[1], $sth->err, "$test list context err");
253		-is($error[2], $sth->state, "$test list context state");
254		-
255		-$error = $result->error;
256		-is($error, $sth->errstr, "$test scalar context");
257		-

...	...	@@ -1,236 +0,0 @@
1		-use strict;
2		-use warnings;
3		-
4		-use Test::More 'no_plan';
5		-
6		-use DBIx::Custom::SQL::Template;
7		-
8		-# Function for test name
9		-my $test;
10		-sub test{
11		- $test = shift;
12		-}
13		-
14		-# Variable for test
15		-my $datas;
16		-my $sql_tmpl;
17		-my $query;
18		-my $ret_val;
19		-my $clone;
20		-
21		-test "Various template pattern";
22		-$datas = [
23		- # Basic tests
24		- { name => 'placeholder basic',
25		- tmpl => "a {? k1} b {= k2} {<> k3} {> k4} {< k5} {>= k6} {<= k7} {like k8}", ,
26		- sql_expected => "a ? b k2 = ? k3 <> ? k4 > ? k5 < ? k6 >= ? k7 <= ? k8 like ?;",
27		- key_infos_expected => [
28		- {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1']]},
29		- {original_key => 'k2', table => '', column => 'k2', access_keys => [['k2']]},
30		- {original_key => 'k3', table => '', column => 'k3', access_keys => [['k3']]},
31		- {original_key => 'k4', table => '', column => 'k4', access_keys => [['k4']]},
32		- {original_key => 'k5', table => '', column => 'k5', access_keys => [['k5']]},
33		- {original_key => 'k6', table => '', column => 'k6', access_keys => [['k6']]},
34		- {original_key => 'k7', table => '', column => 'k7', access_keys => [['k7']]},
35		- {original_key => 'k8', table => '', column => 'k8', access_keys => [['k8']]},
36		- ],
37		- },
38		- {
39		- name => 'placeholder in',
40		- tmpl => "{in k1 3};",
41		- sql_expected => "k1 in (?, ?, ?);",
42		- key_infos_expected => [
43		- {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [0]]]},
44		- {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [1]]]},
45		- {original_key => 'k1', table => '', column => 'k1', access_keys => [['k1', [2]]]},
46		- ],
47		- },
48		- {
49		- name => 'insert',
50		- tmpl => "{insert k1 k2 k3}",
51		- sql_expected => "(k1, k2, k3) values (?, ?, ?);",
52		- key_infos_expected => [
53		- {original_key => 'k1', table => '', column => 'k1', access_keys => [['#insert', 'k1'], ['k1']]},
54		- {original_key => 'k2', table => '', column => 'k2', access_keys => [['#insert', 'k2'], ['k2']]},
55		- {original_key => 'k3', table => '', column => 'k3', access_keys => [['#insert', 'k3'], ['k3']]},
56		- ],
57		- },
58		- {
59		- name => 'update',
60		- tmpl => "{update k1 k2 k3}",
61		- sql_expected => "set k1 = ?, k2 = ?, k3 = ?;",
62		- key_infos_expected => [
63		- {original_key => 'k1', table => '', column => 'k1', access_keys => [['#update', 'k1'], ['k1']]},
64		- {original_key => 'k2', table => '', column => 'k2', access_keys => [['#update', 'k2'], ['k2']]},
65		- {original_key => 'k3', table => '', column => 'k3', access_keys => [['#update', 'k3'], ['k3']]},
66		- ],
67		- },
68		-
69		- # Table name
70		- {
71		- name => 'placeholder with table name',
72		- tmpl => "{= a.k1} {= a.k2}",
73		- sql_expected => "a.k1 = ? a.k2 = ?;",
74		- key_infos_expected => [
75		- {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1'], ['a', 'k1']]},
76		- {original_key => 'a.k2', table => 'a', column => 'k2', access_keys => [['a.k2'], ['a', 'k2']]},
77		- ],
78		- },
79		- {
80		- name => 'placeholder in with table name',
81		- tmpl => "{in a.k1 2} {in b.k2 2}",
82		- sql_expected => "a.k1 in (?, ?) b.k2 in (?, ?);",
83		- key_infos_expected => [
84		- {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [0]], ['a', 'k1', [0]]]},
85		- {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['a.k1', [1]], ['a', 'k1', [1]]]},
86		- {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [0]], ['b', 'k2', [0]]]},
87		- {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['b.k2', [1]], ['b', 'k2', [1]]]},
88		- ],
89		- },
90		- {
91		- name => 'insert with table name',
92		- tmpl => "{insert a.k1 b.k2}",
93		- sql_expected => "(k1, k2) values (?, ?);",
94		- key_infos_expected => [
95		- {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['#insert', 'a.k1'], ['#insert', 'a', 'k1'], ['a.k1'], ['a', 'k1']]},
96		- {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['#insert', 'b.k2'], ['#insert', 'b', 'k2'], ['b.k2'], ['b', 'k2']]},
97		- ],
98		- },
99		- {
100		- name => 'update with table name',
101		- tmpl => "{update a.k1 b.k2}",
102		- sql_expected => "set k1 = ?, k2 = ?;",
103		- key_infos_expected => [
104		- {original_key => 'a.k1', table => 'a', column => 'k1', access_keys => [['#update', 'a.k1'], ['#update', 'a', 'k1'], ['a.k1'], ['a', 'k1']]},
105		- {original_key => 'b.k2', table => 'b', column => 'k2', access_keys => [['#update', 'b.k2'], ['#update', 'b', 'k2'], ['b.k2'], ['b', 'k2']]},
106		- ],
107		- },
108		- {
109		- name => 'not contain tag',
110		- tmpl => "aaa",
111		- sql_expected => "aaa;",
112		- key_infos_expected => [],
113		- }
114		-];
115		-
116		-for (my $i = 0; $i < @$datas; $i++) {
117		- my $data = $datas->[$i];
118		- my $sql_tmpl = DBIx::Custom::SQL::Template->new;
119		- my $query = $sql_tmpl->create_query($data->{tmpl});
120		- is($query->{sql}, $data->{sql_expected}, "$test : $data->{name} : sql");
121		- is_deeply($query->{key_infos}, $data->{key_infos_expected}, "$test : $data->{name} : key_infos");
122		-}
123		-
124		-
125		-test 'Original tag processor';
126		-$sql_tmpl = DBIx::Custom::SQL::Template->new;
127		-
128		-$ret_val = $sql_tmpl->add_tag_processor(
129		- p => sub {
130		- my ($tag_name, $args) = @_;
131		-
132		- my $expand = "$tag_name ? $args->[0] $args->[1]";
133		- my $key_infos = [2];
134		- return ($expand, $key_infos);
135		- }
136		-);
137		-
138		-$query = $sql_tmpl->create_query("{p a b}");
139		-is($query->{sql}, "p ? a b;", "$test : add_tag_processor sql");
140		-is_deeply($query->{key_infos}, [2], "$test : add_tag_processor key_infos");
141		-isa_ok($ret_val, 'DBIx::Custom::SQL::Template');
142		-
143		-
144		-test "Tag processor error case";
145		-$sql_tmpl = DBIx::Custom::SQL::Template->new;
146		-
147		-
148		-eval{$sql_tmpl->create_query("{a }")};
149		-like($@, qr/Tag '{a }' in SQL template is not exist/, "$test : tag_processor not exist");
150		-
151		-$sql_tmpl->add_tag_processor({
152		- q => 'string'
153		-});
154		-
155		-eval{$sql_tmpl->create_query("{q}", {})};
156		-like($@, qr/Tag processor 'q' must be code reference/, "$test : tag_processor not code ref");
157		-
158		-$sql_tmpl->add_tag_processor({
159		- r => sub {}
160		-});
161		-
162		-eval{$sql_tmpl->create_query("{r}")};
163		-like($@, qr/\QTag processor 'r' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return noting");
164		-
165		-$sql_tmpl->add_tag_processor({
166		- s => sub { return ("a", "")}
167		-});
168		-
169		-eval{$sql_tmpl->create_query("{s}")};
170		-like($@, qr/\QTag processor 's' must return (\E\$expand\Q, \E\$key_infos\Q)/, "$test : tag processor return not array key_infos");
171		-
172		-$sql_tmpl->add_tag_processor(
173		- t => sub {return ("a", [])}
174		-);
175		-
176		-eval{$sql_tmpl->create_query("{t ???}")};
177		-like($@, qr/Tag '{t }' arguments cannot contain '?'/, "$test : cannot contain '?' in tag argument");
178		-
179		-
180		-test 'General error case';
181		-$sql_tmpl = DBIx::Custom::SQL::Template->new;
182		-$sql_tmpl->add_tag_processor(
183		- a => sub {
184		- return ("? ? ?", [[],[]]);
185		- }
186		-);
187		-eval{$sql_tmpl->create_query("{a}")};
188		-like($@, qr/Placeholder count in SQL created by tag processor 'a' must be same as key informations count/, "$test placeholder count is invalid");
189		-
190		-
191		-test 'Default tag processor Error case';
192		-eval{$sql_tmpl->create_query("{= }")};
193		-like($@, qr/You must be pass key as argument to tag '{= }'/, "$test : basic '=' : key not exist");
194		-
195		-eval{$sql_tmpl->create_query("{in }")};
196		-like($@, qr/You must be pass key as first argument of tag '{in }'/, "$test : in : key not exist");
197		-
198		-eval{$sql_tmpl->create_query("{in a}")};
199		-like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
200		- "$test : in : key not exist");
201		-
202		-eval{$sql_tmpl->create_query("{in a r}")};
203		-like($@, qr/\QYou must be pass placeholder count as second argument of tag '{in }'\E\n\QUsage: {in \E\$key\Q \E\$placeholder_count\Q}/,
204		- "$test : in : key not exist");
205		-
206		-
207		-test 'Clone';
208		-$sql_tmpl = DBIx::Custom::SQL::Template->new;
209		-$sql_tmpl
210		- ->tag_start('[')
211		- ->tag_end(']')
212		- ->tag_syntax('syntax')
213		- ->tag_processors({a => 1, b => 2});
214		-
215		-$clone = $sql_tmpl->clone;
216		-is($clone->tag_start, $sql_tmpl->tag_start, "$test : tag_start");
217		-is($clone->tag_end, $sql_tmpl->tag_end, "$test : tag_end");
218		-is($clone->tag_syntax, $sql_tmpl->tag_syntax, "$test : tag_syntax");
219		-
220		-is_deeply( scalar $clone->tag_processors, scalar $sql_tmpl->tag_processors,
221		- "$test : tag_processors deep clone");
222		-
223		-isnt($clone->tag_processors, $sql_tmpl->tag_processors,
224		- "$test : tag_processors reference not copy");
225		-
226		-$sql_tmpl->tag_processors(undef);
227		-
228		-$clone = $sql_tmpl->clone;
229		-is_deeply(scalar $clone->tag_processors, {}, "$test tag_processor undef copy");
230		-
231		-
232		-
233		-__END__
234		-
235		-
236		-

...	...	@@ -1,69 +0,0 @@
1		-use Test::More;
2		-use strict;
3		-use warnings;
4		-use utf8;
5		-
6		-BEGIN {
7		- eval { require DBD::SQLite; 1 }
8		- or plan skip_all => 'DBD::SQLite required';
9		- eval { DBD::SQLite->VERSION >= 1.25 }
10		- or plan skip_all => 'DBD::SQLite >= 1.25 required';
11		-
12		- plan 'no_plan';
13		- use_ok('DBIx::Custom::SQLite');
14		-}
15		-
16		-# Function for test name
17		-my $test;
18		-sub test {
19		- $test = shift;
20		-}
21		-
22		-# Constant varialbes for test
23		-my $CREATE_TABLE = {
24		- 0 => 'create table table1 (key1 char(255), key2 char(255));',
25		- 1 => 'create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));',
26		- 2 => 'create table table2 (key1 char(255), key3 char(255));'
27		-};
28		-
29		-
30		-# Variables for tests
31		-my $dbi;
32		-my $ret_val;
33		-my $rows;
34		-my $db_file;
35		-
36		-test 'connect_memory';
37		-$dbi = DBIx::Custom::SQLite->new;
38		-$dbi->connect_memory;
39		-$ret_val = $dbi->do($CREATE_TABLE->{0});
40		-ok(defined $ret_val, $test);
41		-$dbi->utf8_filter_on;
42		-$dbi->insert('table1', {key1 => 'あ', key2 => 2});
43		-$rows = $dbi->select('table1', {key1 => 'あ'})->fetch_hash_all;
44		-is_deeply($rows, [{key1 => 'あ', key2 => 2}], "$test : select rows");
45		-
46		-test 'connect_memory error';
47		-eval{$dbi->connect_memory};
48		-like($@, qr/Already connected/, "$test : already connected");
49		-
50		-test 'reconnect_memory';
51		-$dbi = DBIx::Custom::SQLite->new;
52		-$dbi->reconnect_memory;
53		-$ret_val = $dbi->do($CREATE_TABLE->{0});
54		-ok(defined $ret_val, "$test : connect first");
55		-$dbi->reconnect_memory;
56		-$ret_val = $dbi->do($CREATE_TABLE->{2});
57		-ok(defined $ret_val, "$test : connect first");
58		-
59		-test 'connect';
60		-$db_file = 't/test.db';
61		-unlink $db_file if -f $db_file;
62		-$dbi = DBIx::Custom::SQLite->new(database => $db_file);
63		-$dbi->connect;
64		-ok(-f $db_file, "$test : database file");
65		-$ret_val = $dbi->do($CREATE_TABLE->{0});
66		-ok(defined $ret_val, "$test : database");
67		-$dbi->disconnect;
68		-unlink $db_file if -f $db_file;
69		-

...	...	@@ -1,18 +0,0 @@
1		-use strict;
2		-use warnings;
3		-use Test::More;
4		-
5		-# Ensure a recent version of Test::Pod::Coverage
6		-my $min_tpc = 1.08;
7		-eval "use Test::Pod::Coverage $min_tpc";
8		-plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
9		- if $@;
10		-
11		-# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
12		-# but older versions don't recognize some common documentation styles
13		-my $min_pc = 0.18;
14		-eval "use Pod::Coverage $min_pc";
15		-plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
16		- if $@;
17		-
18		-all_pod_coverage_ok();

...	...	@@ -1,12 +0,0 @@
1		-#!perl -T
2		-
3		-use strict;
4		-use warnings;
5		-use Test::More;
6		-
7		-# Ensure a recent version of Test::Pod
8		-my $min_tp = 1.22;
9		-eval "use Test::Pod $min_tp";
10		-plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
11		-
12		-all_pod_files_ok();

...	...	@@ -1,11 +0,0 @@
1		-*.bak
2		-*.BAK
3		-Build
4		-MANIFEST
5		-META.yml
6		-Makefile.PL
7		-_build/*
8		-blib/*
9		-*.tar.gz
10		-cover_db/*
11		-*.tmp

...	...	@@ -1,24 +0,0 @@
1		-use strict;
2		-use warnings;
3		-use Module::Build;
4		-
5		-my $builder = Module::Build->new(
6		- module_name => 'DBIx::Custom::Basic',
7		- license => 'perl',
8		- dist_author => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
9		- dist_version_from => 'lib/DBIx/Custom/Basic.pm',
10		- build_requires => {
11		- 'Test::More' => 0,
12		- },
13		- requires => {
14		- 'Encode' => 0,
15		- 'DBIx::Custom' => 0.0101
16		- },
17		- recommends => {
18		- 'Time::Piece' => 1.15
19		- },
20		- add_to_cleanup => [ 'DBIx-Custom-Basic-*' ],
21		- create_makefile_pl => 'traditional',
22		-);
23		-
24		-$builder->create_build_script();

...	...	@@ -1,8 +0,0 @@
1		-0.0201
2		- delete default_bind_filter
3		- delete default_fetch_filter
4		- add filter encode_utf8
5		- add filter decode_utf8
6		- add method utf8_filter_on
7		-0.0101
8		- First release

...	...	@@ -1,15 +0,0 @@
1		-\bRCS\b
2		-\bCVS\b
3		-^MANIFEST\.
4		-^Makefile$
5		-^Build$
6		-^Build.bat$
7		-^_build/
8		-\.(bak\|tdy\|old\|tmp)$
9		-~$
10		-^blib/
11		-^pm_to_blib
12		-\.cvsignore
13		-\.gz$
14		-^\.git
15		-^cover_db/

...	...	@@ -1,15 +0,0 @@
1		-DBIx-Custom-Basic
2		-
3		-DBIx::Custom basic implementation
4		-
5		-INSTALLATION
6		-
7		-cpan DBIx::Custom::Basic
8		-
9		-COPYRIGHT AND LICENCE
10		-
11		-Copyright (C) 2009 Yuki Kimoto
12		-
13		-This program is free software; you can redistribute it and/or modify it
14		-under the same terms as Perl itself.
15		-

...	...	@@ -1,119 +0,0 @@
1		-package DBIx::Custom::Basic;
2		-use 5.008001;
3		-use base 'DBIx::Custom';
4		-use Encode qw/decode encode/;
5		-
6		-use warnings;
7		-use strict;
8		-
9		-our $VERSION = '0.0201';
10		-
11		-my $class = __PACKAGE__;
12		-
13		-$class->add_filter(
14		- encode_utf8 => sub {
15		- my $value = shift;
16		- utf8::upgrade($value) unless Encode::is_utf8($value);
17		- return encode('UTF-8', $value);
18		- },
19		- decode_utf8 => sub { decode('UTF-8', shift) }
20		-);
21		-
22		-$class->add_format(
23		- 'SQL99_date' => '%Y-%m-%d',
24		- 'SQL99_datetime' => '%Y-%m-%d %H:%M:%S',
25		- 'SQL99_time' => '%H:%M:%S',
26		- 'ISO-8601_date' => '%Y-%m-%d',
27		- 'ISO-8601_datetime' => '%Y-%m-%dT%H:%M:%S',
28		- 'ISO-8601_time' => '%H:%M:%S',
29		-);
30		-
31		-# Methods
32		-sub utf8_filter_on {
33		- my $self = shift;
34		- $self->bind_filter($self->filters->{encode_utf8});
35		- $self->fetch_filter($self->filters->{decode_utf8});
36		-}
37		-
38		-1;
39		-
40		-=head1 NAME
41		-
42		-DBIx::Custom::Basic - DBIx::Custom basic implementation
43		-
44		-=head1 Version
45		-
46		-Version 0.0201
47		-
48		-=head1 See DBIx::Custom documentation
49		-
50		-This class is L<DBIx::Custom> subclass.
51		-
52		-You can use all methods of L<DBIx::Custom>
53		-
54		-Please see L<DBIx::Custom> documentation
55		-
56		-=head1 Filters
57		-
58		-=head2 encode_utf8
59		-
60		- # Encode to UTF-8 byte stream (utf8::upgrade is done if need)
61		- $dbi->filters->{encode_utf8}->($value);
62		-
63		-This filter is generally used as bind filter
64		-
65		- $dbi->bind_filter($dbi->filters->{encode_utf8});
66		-
67		-=head2 decode_utf8
68		-
69		- # Decode to perl internal string
70		- $dbi->filters->{decode_utf8}->($value);
71		-
72		-This filter is generally used as fetch filter
73		-
74		- $dbi->fetch_filter($dbi->filters->{decode_utf8});
75		-
76		-=head2 Formats
77		-
78		-strptime formats is available
79		-
80		- # format name format
81		- 'SQL99_date' '%Y-%m-%d',
82		- 'SQL99_datetime' '%Y-%m-%d %H:%M:%S',
83		- 'SQL99_time' '%H:%M:%S',
84		- 'ISO-8601_date' '%Y-%m-%d',
85		- 'ISO-8601_datetime' '%Y-%m-%dT%H:%M:%S',
86		- 'ISO-8601_time' '%H:%M:%S',
87		-
88		-You get format as the following
89		-
90		- my $format = $dbi->formats->{$format_name};
91		-
92		-=head1 Methods
93		-
94		-=head2 utf8_filter_on
95		-
96		- # Encode and decode utf8 filter on
97		- $dbi->utf8_filter_on;
98		-
99		-This equel to
100		-
101		- $dbi->bind_filter($dbi->filters->{encode_utf8});
102		- $dbi->fetch_filter($dbi->filters->{decode_utf8});
103		-
104		-=head1 AUTHOR
105		-
106		-Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
107		-
108		-Github L<http://github.com/yuki-kimoto>
109		-
110		-I develope this module L<http://github.com/yuki-kimoto/DBIx-Custom>
111		-
112		-=head1 COPYRIGHT & LICENSE
113		-
114		-Copyright 2009 Yuki Kimoto, all rights reserved.
115		-
116		-This program is free software; you can redistribute it and/or modify it
117		-under the same terms as Perl itself.
118		-
119		-=cut