Guest User

Untitled

a guest
Jun 13th, 2018
126
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.02 KB | None | 0 0
  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4.  
  5. # mysql -h localhost test
  6. # create table hoge (id int(10) auto_increment, hoge char(16), fuga char(16), t int(10), primary key (id));
  7. # insert into hoge (hoge, fuga, t) values ('aaa', 'xxx', UNIX_TIMESTAMP()), ('bbb', 'yyy', UNIX_TIMESTAMP()), ('ccc', 'zzz', UNIX_TIMESTAMP());
  8.  
  9. package My::DB;
  10. use DBIx::Skinny setup => +{
  11. dsn => 'dbi:mysql:test',
  12. username => '',
  13. password => '',
  14. };
  15. 1;
  16.  
  17.  
  18.  
  19.  
  20. package My::DB::Schema;
  21. use base qw/DBIx::Skinny::Schema::Loader/;
  22. use DBIx::Skinny::Schema;
  23.  
  24. __PACKAGE__->load_schema;
  25. 1;
  26.  
  27.  
  28.  
  29.  
  30. package main;
  31. use Data::Dumper;
  32. use Carp;
  33. use Try::Tiny;
  34.  
  35. sub d {
  36. my $d = Dumper @_;
  37. print $d;
  38. }
  39.  
  40.  
  41. sub main {
  42. d [
  43. $],
  44. $DBI::VERSION,
  45. $DBIx::Skinny::VERSION,
  46. ];
  47.  
  48. my $sk = My::DB->new;
  49.  
  50. rs_test($sk, [
  51. {
  52. select => [
  53. '*'
  54. ],
  55. from => [
  56. 'hoge',
  57. ],
  58. },
  59.  
  60. {
  61. select => [
  62. 'foo.*',
  63. ],
  64. from => [
  65. 'hoge AS foo',
  66. ],
  67. },
  68.  
  69. {
  70. select => [
  71. 'foo.id AS id'
  72. ],
  73. from => [
  74. 'hoge AS foo',
  75. ],
  76. },
  77.  
  78. {
  79. select => [
  80. 'foo.id id'
  81. ],
  82. from => [
  83. 'hoge foo',
  84. ],
  85. },
  86. ]);
  87.  
  88. print "\n**** finish ****\n";
  89. }
  90.  
  91.  
  92. sub rs_test {
  93. my ($sk, $patterns) = @_;
  94. my $i_test = 0;
  95.  
  96. for my $p (@$patterns) {
  97. ++$i_test;
  98. print "\n**** Test: $i_test ****\n";
  99. _test($sk, $p);
  100. }
  101. }
  102.  
  103. sub _test {
  104. my ($sk, $p) = @_;
  105.  
  106. my $rs = $sk->resultset($p);
  107. d $rs->as_sql;
  108.  
  109. try {
  110. # opt_table_info をせっていしてあげる
  111. my $itr = $rs->retrieve('hoge');
  112. d $itr->count;
  113. }
  114. catch {
  115. carp shift;
  116. };
  117. }
  118.  
  119.  
  120. main();
  121. __END__
  122.  
  123. @ Perl-5.12.1
  124.  
  125. $VAR1 = [
  126. '5.012001',
  127. '1.613',
  128. '0.0720'
  129. ];
  130.  
  131. **** Test: 1 ****
  132. $VAR1 = 'SELECT *
  133. FROM hoge
  134. ';
  135. $VAR1 = 3;
  136.  
  137. **** Test: 2 ****
  138. $VAR1 = 'SELECT foo.*
  139. FROM hoge AS foo
  140. ';
  141. Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/site_perl/5.12.1/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/site_perl/5.12.1 /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/5.12.1/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/5.12.1 .) at (eval 20) line 2.
  142. BEGIN failed--compilation aborted at (eval 20) line 2.
  143. at ./test.pl line 113
  144.  
  145. **** Test: 3 ****
  146. $VAR1 = 'SELECT foo.id AS id
  147. FROM hoge AS foo
  148. ';
  149. Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/site_perl/5.12.1/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/site_perl/5.12.1 /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/5.12.1/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.12.1/lib/5.12.1 .) at (eval 21) line 2.
  150. BEGIN failed--compilation aborted at (eval 21) line 2.
  151. at ./test.pl line 113
  152.  
  153. **** Test: 4 ****
  154. $VAR1 = 'SELECT foo.id id
  155. FROM hoge foo
  156. ';
  157. Bareword "Foo" not allowed while "strict subs" in use at (eval 22) line 1.
  158. at ./test.pl line 113
  159.  
  160. **** finish ****
  161.  
  162.  
  163.  
  164.  
  165. @ Perl-5.8.8 (とあるサーバの都合上)
  166.  
  167. $VAR1 = [
  168. '5.008008',
  169. '1.613',
  170. '0.0720'
  171. ];
  172.  
  173. **** Test: 1 ****
  174. $VAR1 = 'SELECT *
  175. FROM hoge
  176. ';
  177. $VAR1 = 3;
  178.  
  179. **** Test: 2 ****
  180. $VAR1 = 'SELECT foo.*
  181. FROM hoge AS foo
  182. ';
  183. Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl .) at (eval 18) line 2.
  184. BEGIN failed--compilation aborted at (eval 18) line 2.
  185. at ./test.pl line 116
  186.  
  187. **** Test: 3 ****
  188. $VAR1 = 'SELECT foo.id AS id
  189. FROM hoge AS foo
  190. ';
  191. Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl .) at (eval 19) line 2.
  192. BEGIN failed--compilation aborted at (eval 19) line 2.
  193. at ./test.pl line 116
  194.  
  195. **** Test: 4 ****
  196. $VAR1 = 'SELECT foo.id id
  197. FROM hoge foo
  198. ';
  199. Can't locate My/DB/Row/Hoge.pm in @INC (@INC contains: /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8/darwin-2level /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl/5.8.8 /Users/iwata/perl5/perlbrew/perls/perl-5.8.8/lib/site_perl .) at (eval 20) line 2.
  200. BEGIN failed--compilation aborted at (eval 20) line 2.
  201. at ./test.pl line 116
  202.  
  203. **** finish ****
Add Comment
Please, Sign In to add comment