add tests ・ 955b9fe ・ Gitprep

- add tests;
- Browse files
- yuki-kimoto commited on 2009-10-18
- 1 parent 677c3c3
  
  commit 955b9fe2c2b5b859e0dd33706601d93174594649

Showing 2 changed files with 71 additions and 14 deletions

+53 -8

lib/DBI/Custom.pm

@@ -52,13 +52,13 @@ sub clone {
 # Attribute
 sub connect_info       : Attr { type => 'hash',  auto_build => sub { shift->connect_info({}) } }
 
-sub bind_filter : Attr {}
+sub bind_filter  : Attr {}
 sub fetch_filter : Attr {}
 
 sub filters : Attr { type => 'hash', deref => 1, auto_build => sub { shift->filters({}) } }
 sub add_filter { shift->filters(@_) }
-sub result_class : Attr { default => 'DBI::Custom::Result' }
 
+sub result_class : Attr { auto_build => sub { shift->result_class('DBI::Custom::Result') }}
 sub dbh          : Attr { auto_build => sub { shift->connect } }
 sub sql_template : Attr { auto_build => sub { shift->sql_template(DBI::Custom::SQLTemplate->new) } }
 
@@ -87,20 +87,25 @@ sub connect {
         }
     );
     
-    $self->auto_commit($self->dbh->{AutoCommit});
+    $self->auto_commit($dbh->{AutoCommit});
     $self->dbh($dbh);
 }
 
+sub DESTROY {
+    my $self = shift;
+    $self->disconnect;
+}
+
 # Is connected?
 sub connected {
     my $self = shift;
-    return exists $sefl->{dbh};
+    return exists $self->{dbh} && eval {$self->dbh->can('prepare')};
 }
 
 # Disconnect
 sub disconnect {
     my $self = shift;
-    if ($self->conneced) {
+    if ($self->connected) {
         $self->dbh->disconnect;
         delete $self->{dbh};
     }
@@ -109,10 +114,21 @@ sub disconnect {
 # Reconnect
 sub reconnect {
     my $self = shift;
-    $sefl->disconnect if $self->connected;
+    $self->disconnect if $self->connected;
     $self->connect;
 }
 
+sub dbh_option {
+    my $self = shift;
+    croak("Not connected") unless $self->connected;
+    my $dbh = $self->dbh;
+    if (@_ > 1) {
+        $dbh->{$_[0]} = $_[1];
+        return $self;
+    }
+    return $dbh->{$_[0]}
+}
+
 
 sub create_sql {
     my $self = shift;
@@ -125,11 +141,26 @@ sub create_sql {
 sub query {
     my ($self, $template, $values, $filter)  = @_;
     
+    my $sth_options;
+    
+    # Rearrange when argumets is hash referecne 
+    if (ref $template eq 'HASH') {
+        my $args = $template;
+        ($template, $values, $filter, $sth_options)
+          = @{$args}{qw/template values filter sth_options/};
+    }
+    
     $filter ||= $self->bind_filter;
     
     my ($sql, @bind) = $self->create_sql($template, $values, $filter);
-    my (
     my $sth = $self->dbh->prepare($sql);
+    
+    if ($sth_options) {
+        foreach my $key (keys %$sth_options) {
+            $sth->{$key} = $sth_options->{$key};
+        }
+    }
+    
     $sth->execute(@bind);
     
     # Select
@@ -141,6 +172,7 @@ sub query {
     return;
 }
 
+
 sub query_raw_sql {
     my ($self, $sql, @bind) = @_;
     my $sth = $self->dbh->prepare($sql);
@@ -148,7 +180,8 @@ sub query_raw_sql {
     return $sth;
 }
 
-sub auto_commit : Attr {
+sub auto_commit : Attr {}
+
 
 Object::Simple->build_class;
 
@@ -398,6 +431,18 @@ Version 0.0101
 
 =head2 sql_template
 
+=head2 auto_commit
+
+=head2 connected
+
+=head2 dbh_option
+
+=head2 disconnect
+
+=head2 reconnect
+
+=head2 result_class
+
 =head1 AUTHOR
 
 Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>

+18 -6

t/01-core.t

View

@@ -23,9 +23,12 @@ our ($U, $P, $D) = connect_info();
         bind_filter => 'f',
         fetch_filter => 'g',
         dbh => 'e',
+        result_class => 'g'
     );
     
-    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}}                       ,filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', dbh => 'e'}, 'new');
+    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', 
+                    options => {d => 1, e => 2}}, filters => {f => 3}, bind_filter => 'f',
+                    fetch_filter => 'g', dbh => 'e', result_class => 'g'}, 'new');
     
     isa_ok($dbi, 'DBI::Custom');
 }
@@ -65,9 +68,11 @@ our ($U, $P, $D) = connect_info();
         },
         bind_filter => 'fo',
         fetch_filter => 'go',
+        result_class => 'ho'
     );
     
-    is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}}                       ,filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go'}, 'new arguments');
+    is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}}
+                    ,filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go', result_class => 'ho'}, 'new arguments');
     
     isa_ok($dbi, 'DBI::Custom::T1');
 }
@@ -75,7 +80,8 @@ our ($U, $P, $D) = connect_info();
 {
     my $dbi = DBI::Custom::T1->new;
     
-    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}}                       ,filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g'}, 'new custom class');
+    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}},
+                    filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', result_class => 'DBI::Custom::Result'}, 'new custom class');
     
     isa_ok($dbi, 'DBI::Custom::T1');
     
@@ -89,7 +95,8 @@ our ($U, $P, $D) = connect_info();
 {
     my $dbi = DBI::Custom::T1_2->new;
     
-    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}}                       ,filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g'}, 'new custom class inherit');
+    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}},
+                    filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', result_class => 'DBI::Custom::Result'}, 'new custom class inherit');
     
     isa_ok($dbi, 'DBI::Custom::T1_2');
 }
@@ -114,6 +121,8 @@ our ($U, $P, $D) = connect_info();
           ->bind_filter('fo')
           ->fetch_filter('go')
           ->dbh('eo')
+          ->result_class('ho');
+       
     });
     
 }
@@ -121,7 +130,8 @@ our ($U, $P, $D) = connect_info();
 {
     my $dbi = DBI::Custom::T1_3->new;
     
-    is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}}                       ,filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go'}, 'new custom class');
+    is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}},
+                    filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go', result_class => 'ho'}, 'new custom class');
     
     isa_ok($dbi, 'DBI::Custom::T1_3');
 }
@@ -140,9 +150,11 @@ our ($U, $P, $D) = connect_info();
         bind_filter => 'f',
         fetch_filter => 'g',
         dbh => 'e',
+        result_class => 'h'
     );
     
-    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}}                       ,filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', dbh => 'e'}, 'new');
+    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}},
+                    filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', dbh => 'e', result_class => 'h'}, 'new');
     
     isa_ok($dbi, 'DBI::Custom');
 }

...	...	@@ -52,13 +52,13 @@ sub clone {
52	52	# Attribute
53	53	sub connect_info : Attr { type => 'hash', auto_build => sub { shift->connect_info({}) } }
54	54
55		-sub bind_filter : Attr {}
	55	+sub bind_filter : Attr {}
56	56	sub fetch_filter : Attr {}
57	57
58	58	sub filters : Attr { type => 'hash', deref => 1, auto_build => sub { shift->filters({}) } }
59	59	sub add_filter { shift->filters(@_) }
60		-sub result_class : Attr { default => 'DBI::Custom::Result' }
61	60
	61	+sub result_class : Attr { auto_build => sub { shift->result_class('DBI::Custom::Result') }}
62	62	sub dbh : Attr { auto_build => sub { shift->connect } }
63	63	sub sql_template : Attr { auto_build => sub { shift->sql_template(DBI::Custom::SQLTemplate->new) } }
64	64
...	...	@@ -87,20 +87,25 @@ sub connect {
87	87	}
88	88	);
89	89
90		- $self->auto_commit($self->dbh->{AutoCommit});
	90	+ $self->auto_commit($dbh->{AutoCommit});
91	91	$self->dbh($dbh);
92	92	}
93	93
	94	+sub DESTROY {
	95	+ my $self = shift;
	96	+ $self->disconnect;
	97	+}
	98	+
94	99	# Is connected?
95	100	sub connected {
96	101	my $self = shift;
97		- return exists $sefl->{dbh};
	102	+ return exists $self->{dbh} && eval {$self->dbh->can('prepare')};
98	103	}
99	104
100	105	# Disconnect
101	106	sub disconnect {
102	107	my $self = shift;
103		- if ($self->conneced) {
	108	+ if ($self->connected) {
104	109	$self->dbh->disconnect;
105	110	delete $self->{dbh};
106	111	}
...	...	@@ -109,10 +114,21 @@ sub disconnect {
109	114	# Reconnect
110	115	sub reconnect {
111	116	my $self = shift;
112		- $sefl->disconnect if $self->connected;
	117	+ $self->disconnect if $self->connected;
113	118	$self->connect;
114	119	}
115	120
	121	+sub dbh_option {
	122	+ my $self = shift;
	123	+ croak("Not connected") unless $self->connected;
	124	+ my $dbh = $self->dbh;
	125	+ if (@_ > 1) {
	126	+ $dbh->{$_[0]} = $_[1];
	127	+ return $self;
	128	+ }
	129	+ return $dbh->{$_[0]}
	130	+}
	131	+
116	132
117	133	sub create_sql {
118	134	my $self = shift;
...	...	@@ -125,11 +141,26 @@ sub create_sql {
125	141	sub query {
126	142	my ($self, $template, $values, $filter) = @_;
127	143
	144	+ my $sth_options;
	145	+
	146	+ # Rearrange when argumets is hash referecne
	147	+ if (ref $template eq 'HASH') {
	148	+ my $args = $template;
	149	+ ($template, $values, $filter, $sth_options)
	150	+ = @{$args}{qw/template values filter sth_options/};
	151	+ }
	152	+
128	153	$filter \|\|= $self->bind_filter;
129	154
130	155	my ($sql, @bind) = $self->create_sql($template, $values, $filter);
131		- my (
132	156	my $sth = $self->dbh->prepare($sql);
	157	+
	158	+ if ($sth_options) {
	159	+ foreach my $key (keys %$sth_options) {
	160	+ $sth->{$key} = $sth_options->{$key};
	161	+ }
	162	+ }
	163	+
133	164	$sth->execute(@bind);
134	165
135	166	# Select
...	...	@@ -141,6 +172,7 @@ sub query {
141	172	return;
142	173	}
143	174
	175	+
144	176	sub query_raw_sql {
145	177	my ($self, $sql, @bind) = @_;
146	178	my $sth = $self->dbh->prepare($sql);
...	...	@@ -148,7 +180,8 @@ sub query_raw_sql {
148	180	return $sth;
149	181	}
150	182
151		-sub auto_commit : Attr {
	183	+sub auto_commit : Attr {}
	184	+
152	185
153	186	Object::Simple->build_class;
154	187
...	...	@@ -398,6 +431,18 @@ Version 0.0101
398	431
399	432	=head2 sql_template
400	433
	434	+=head2 auto_commit
	435	+
	436	+=head2 connected
	437	+
	438	+=head2 dbh_option
	439	+
	440	+=head2 disconnect
	441	+
	442	+=head2 reconnect
	443	+
	444	+=head2 result_class
	445	+
401	446	=head1 AUTHOR
402	447
403	448	Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>

...	...	@@ -23,9 +23,12 @@ our ($U, $P, $D) = connect_info();
23	23	bind_filter => 'f',
24	24	fetch_filter => 'g',
25	25	dbh => 'e',
	26	+ result_class => 'g'
26	27	);
27	28
28		- is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}} ,filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', dbh => 'e'}, 'new');
	29	+ is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c',
	30	+ options => {d => 1, e => 2}}, filters => {f => 3}, bind_filter => 'f',
	31	+ fetch_filter => 'g', dbh => 'e', result_class => 'g'}, 'new');
29	32
30	33	isa_ok($dbi, 'DBI::Custom');
31	34	}
...	...	@@ -65,9 +68,11 @@ our ($U, $P, $D) = connect_info();
65	68	},
66	69	bind_filter => 'fo',
67	70	fetch_filter => 'go',
	71	+ result_class => 'ho'
68	72	);
69	73
70		- is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}} ,filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go'}, 'new arguments');
	74	+ is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}}
	75	+ ,filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go', result_class => 'ho'}, 'new arguments');
71	76
72	77	isa_ok($dbi, 'DBI::Custom::T1');
73	78	}
...	...	@@ -75,7 +80,8 @@ our ($U, $P, $D) = connect_info();
75	80	{
76	81	my $dbi = DBI::Custom::T1->new;
77	82
78		- is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}} ,filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g'}, 'new custom class');
	83	+ is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}},
	84	+ filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', result_class => 'DBI::Custom::Result'}, 'new custom class');
79	85
80	86	isa_ok($dbi, 'DBI::Custom::T1');
81	87
...	...	@@ -89,7 +95,8 @@ our ($U, $P, $D) = connect_info();
89	95	{
90	96	my $dbi = DBI::Custom::T1_2->new;
91	97
92		- is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}} ,filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g'}, 'new custom class inherit');
	98	+ is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}},
	99	+ filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', result_class => 'DBI::Custom::Result'}, 'new custom class inherit');
93	100
94	101	isa_ok($dbi, 'DBI::Custom::T1_2');
95	102	}
...	...	@@ -114,6 +121,8 @@ our ($U, $P, $D) = connect_info();
114	121	->bind_filter('fo')
115	122	->fetch_filter('go')
116	123	->dbh('eo')
	124	+ ->result_class('ho');
	125	+
117	126	});
118	127
119	128	}
...	...	@@ -121,7 +130,8 @@ our ($U, $P, $D) = connect_info();
121	130	{
122	131	my $dbi = DBI::Custom::T1_3->new;
123	132
124		- is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}} ,filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go'}, 'new custom class');
	133	+ is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}},
	134	+ filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go', result_class => 'ho'}, 'new custom class');
125	135
126	136	isa_ok($dbi, 'DBI::Custom::T1_3');
127	137	}
...	...	@@ -140,9 +150,11 @@ our ($U, $P, $D) = connect_info();
140	150	bind_filter => 'f',
141	151	fetch_filter => 'g',
142	152	dbh => 'e',
	153	+ result_class => 'h'
143	154	);
144	155
145		- is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}} ,filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', dbh => 'e'}, 'new');
	156	+ is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}},
	157	+ filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', dbh => 'e', result_class => 'h'}, 'new');
146	158
147	159	isa_ok($dbi, 'DBI::Custom');
148	160	}