File Coverage

blib/lib/Tree/DAG_Node/Persist/Create.pm
Criterion Covered Total %
statement 39 42 92.8
branch 1 2 50.0
condition n/a
subroutine 9 10 90.0
pod 0 4 0.0
total 49 58 84.4


line stmt bran cond sub pod time code
1             package Tree::DAG_Node::Persist::Create;
2              
3 1     1   41301 use strict;
  1         1  
  1         22  
4 1     1   3 use warnings;
  1         1  
  1         20  
5              
6 1     1   1352 use DBI;
  1         11437  
  1         63  
7              
8 1     1   530 use DBIx::Admin::CreateTable;
  1         24908  
  1         27  
9              
10 1     1   6 use Moo;
  1         0  
  1         3  
11              
12 1     1   692 use Types::Standard qw/Any ArrayRef Str/;
  1         54179  
  1         8  
13              
14             has dbh =>
15             (
16             default => sub{return ''},
17             is => 'rw',
18             isa => Any,
19             required => 0,
20             );
21              
22             has dsn =>
23             (
24             default => sub{return $ENV{DBI_DSN} || ''},
25             is => 'rw',
26             isa => Str,
27             required => 0,
28             );
29              
30             has extra_columns =>
31             (
32             default => sub{return ''},
33             is => 'rw',
34             isa => Str,
35             required => 0,
36             );
37              
38             has extra_column_names =>
39             (
40             default => sub{return []},
41             is => 'rw',
42             isa => ArrayRef,
43             required => 0,
44             );
45              
46             has password =>
47             (
48             default => sub{return $ENV{DBI_PASS} || ''},
49             is => 'rw',
50             isa => Str,
51             required => 0,
52             );
53              
54             has table_name =>
55             (
56             default => sub{return 'trees'},
57             is => 'rw',
58             isa => Str,
59             required => 0,
60             );
61              
62             has username =>
63             (
64             default => sub{return $ENV{DBI_USER} || ''},
65             is => 'rw',
66             isa => Str,
67             required => 0,
68             );
69              
70             our $VERSION = '1.11';
71              
72             # -----------------------------------------------
73              
74             sub BUILD
75             {
76 1     1 0 11 my($self) = @_;
77              
78 1         4 $self -> extra_column_names([split(/\s*,\s*/, $self -> extra_columns)]);
79              
80             } # End of BUILD.
81              
82             # -----------------------------------------------
83              
84             sub connect
85             {
86 1     1 0 877 my($self) = @_;
87              
88             # Warning: Can't just return $self -> dbh(....) for some reason.
89             # Tree::DAG_Node::Persist dies at line 137 ($self -> dbh -> prepare_cached).
90              
91 1         4 $self -> dbh
92             (
93             DBI -> connect
94             (
95             $self -> dsn,
96             $self -> username,
97             $self -> password,
98             {
99             AutoCommit => 1,
100             PrintError => 0,
101             RaiseError => 1,
102             }
103             )
104             );
105              
106 1         9972 return $self -> dbh;
107              
108             } # End of connect.
109              
110             # -----------------------------------------------
111              
112             sub drop_create
113             {
114 1     1 0 422 my($self) = @_;
115 1         20 my($creator) = DBIx::Admin::CreateTable -> new(dbh => $self -> dbh, verbose => 0);
116 1         1673 my($table_name) = $self -> table_name;
117 1         441 my(@extra_columns) = @{$self -> extra_column_names};
  1         15  
118 1         27 my($extra_sql) = '';
119              
120 1 50       5 if ($#extra_columns >= 0)
121             {
122 1         1 my(@sql);
123              
124 1         2 for my $extra (@extra_columns)
125             {
126 1         2 $extra =~ tr/:/ /;
127              
128 1         3 push @sql, "$extra,";
129             }
130              
131 1         2 $extra_sql = join("\n", @sql);
132             }
133              
134 1         17 $creator -> drop_table($self -> table_name);
135              
136 1         455 my($primary_key) = $creator -> generate_primary_key_sql($table_name);
137 1         21 my($result) = $creator -> create_table(<
138             create table $table_name
139             (
140             id $primary_key,
141             mother_id integer not null,
142             $extra_sql
143             unique_id integer not null,
144             context varchar(255) not null,
145             name varchar(255) not null
146             )
147             SQL
148             # 0 is success.
149              
150 1         28993407 return 0;
151              
152             } # End of drop_create.
153              
154             # -----------------------------------------------
155              
156             sub run
157             {
158 0     0 0   my($self) = @_;
159              
160 0           $self -> connect;
161              
162             # 0 is success.
163              
164 0           return $self -> drop_create;
165              
166             } # End of run.
167              
168             # -----------------------------------------------
169              
170             1;