File Coverage

blib/lib/Geoffrey/Read.pm
Criterion Covered Total %
statement 81 84 96.4
branch 21 36 58.3
condition 6 9 66.6
subroutine 17 17 100.0
pod 4 4 100.0
total 129 150 86.0


line stmt bran cond sub pod time code
1             package Geoffrey::Read;
2              
3 3     3   673 use utf8;
  3         8  
  3         24  
4 3     3   156 use 5.016;
  3         11  
5 3     3   18 use strict;
  3         7  
  3         102  
6 3     3   18 use warnings FATAL => 'all';
  3         8  
  3         164  
7 3     3   1699 use Geoffrey::Template;
  3         9  
  3         97  
8 3     3   921 use Geoffrey::Changeset;
  3         8  
  3         118  
9              
10             $Geoffrey::Read::VERSION = '0.000205';
11              
12 3     3   19 use parent 'Geoffrey::Role::Core';
  3         6  
  3         11  
13              
14             sub _obj_entries {
15 8     8   4032 my ($self) = @_;
16 8         709 require Geoffrey::Action::Entry;
17 8   66     48 $self->{entries} //= Geoffrey::Action::Entry->new(dbh => $self->dbh, converter => $self->converter,);
18 8         83 return $self->{entries};
19             }
20              
21             sub _parse_changelogs {
22 1     1   6 my ($self, $ar_changelogs, $s_changelog_root) = @_;
23 1         2 for my $i_changelog (@{$ar_changelogs}) {
  1         3  
24 3 50       76 my $s_changelog
25             = $s_changelog_root
26             ? File::Spec->catfile($s_changelog_root, "changelog-$i_changelog")
27             : "changelog-$i_changelog";
28 3 50       17 return 0 if !$self->_parse_log($s_changelog);
29             }
30 0         0 return 1;
31             }
32              
33             sub _parse_log {
34 3     3   12 my ($self, $s_changelog) = @_;
35 3         7 for (@{$self->changelog_io->load($s_changelog)}) {
  3         12  
36 6         218 my $changeset_result = $self->run_changeset($_, $s_changelog);
37 5 50       66 return 0 if $changeset_result->{exit};
38             }
39 2         82 return 1;
40             }
41              
42             sub _get_sql_abstract {
43 16     16   31 my ($self) = @_;
44 16         1624 require SQL::Abstract;
45 16   66     22816 $self->{sql_abstract} //= SQL::Abstract->new;
46 16         281 return $self->{sql_abstract};
47             }
48              
49             sub _get_changset_by_id {
50 16     16   39 my ($self, $s_changeset_id) = @_;
51 16 50       41 my $s_changelog_name = ($self->schema ? $self->schema . q/./ : q//) . $self->converter->changelog_table;
52 16         56 my $s_changeset_sql = $self->_get_sql_abstract->select($s_changelog_name, qw/*/, {id => $s_changeset_id});
53 16         4062 my $hr_result = $self->dbh->selectrow_hashref($s_changeset_sql, {Slice => {}}, ($s_changeset_id));
54 16 100       3935 return unless $hr_result;
55 1         7 require Geoffrey::Utils;
56 1         4 return Geoffrey::Utils::to_lowercase($hr_result);
57             }
58              
59             sub _check_key {
60 10     10   36 my ($self, $s_changeset_id, $s_md5sum) = @_;
61 10         29 my $hr_db_changeset = $self->_get_changset_by_id($s_changeset_id);
62 10 100       23 return 0 unless scalar keys %{$hr_db_changeset};
  10         62  
63 1 50       4 return 0 unless $hr_db_changeset->{md5sum};
64              
65 1 50       4 if ($hr_db_changeset->{md5sum} ne $s_md5sum) {
66 1         5 require Geoffrey::Exception::Database;
67 1         6 Geoffrey::Exception::Database::throw_changeset_corrupt($s_changeset_id, $s_md5sum, $hr_db_changeset->{md5sum});
68             }
69 0         0 return 1;
70             }
71              
72             sub run_changeset {
73 11     11 1 5194 my ($self, $hr_changeset, $s_file) = @_;
74 11 50       40 return {exit => 1} if $hr_changeset->{stop};
75 11 100       34 if (!$hr_changeset->{id}) {
76 1         6 require Geoffrey::Exception::RequiredValue;
77 1         4 Geoffrey::Exception::RequiredValue::throw_id($s_file);
78             }
79 10         1073 require Hash::MD5;
80 10         8518 my $s_changeset_checksum = Hash::MD5::sum($hr_changeset);
81 10 50       1913 return {key => 1} if $self->_check_key($hr_changeset->{id}, $s_changeset_checksum);
82 9         36 $self->changeset->handle_entries($hr_changeset->{entries});
83 6 50       29 my $s_table_name = ($self->schema ? $self->schema . q/./ : q//) . $self->converter->changelog_table;
84 6         27 require Geoffrey::Utils;
85 6         30 my $hr_db_changeset = Geoffrey::Utils::to_lowercase($self->_get_changset_by_id($hr_changeset->{id}));
86              
87 6 50       41 if ($hr_db_changeset) {
88             return {
89             changeset => $self->_obj_entries->alter(
90             $s_table_name,
91             {id => $hr_changeset->{id}},
92 0         0 [{md5sum => $s_changeset_checksum}],
93             )};
94             }
95              
96             return {
97             changeset => $self->_obj_entries->add({
98             table => $s_table_name,
99             values => [{
100             created_by => $hr_changeset->{author},
101             geoffrey_version => $Geoffrey::Read::VERSION,
102             comment => 'Imported by current db.',
103             id => $hr_changeset->{id},
104 6         23 filename => $s_file,
105             md5sum => $s_changeset_checksum,
106             }]})};
107             }
108              
109 30     30 1 156 sub schema { return shift->{schema}; }
110              
111             sub changeset {
112 12     12 1 30 my ($self, $obj_changeset) = @_;
113 12 50       33 $self->{changeset} = $obj_changeset if $obj_changeset;
114             $self->{changeset}
115 12   66     59 //= Geoffrey::Changeset->new(converter => $self->converter, dbh => $self->dbh, schema => $self->schema,);
116 12         75 return $self->{changeset};
117             }
118              
119             sub run {
120 1     1 1 3 my ($self, $s_changelog_root) = @_;
121 1 50       6 $self->changelog_io->converter($self->converter) if $self->changelog_io->needs_converter;
122 1 50       4 $self->changelog_io->dbh($self->dbh) if $self->changelog_io->needs_dbh;
123 1         3 my $hr_main_changeset = $self->changelog_io->load(File::Spec->catfile($s_changelog_root, 'changelog'));
124 1         47 $self->changeset->template(Geoffrey::Template->new->load_templates($hr_main_changeset->{templates}));
125 1 50       3 $self->changeset->prefix($hr_main_changeset->{prefix} ? $hr_main_changeset->{prefix} . '_' : q~~);
126 1 50       4 $self->changeset->postfix($hr_main_changeset->{postfix} ? '_' . $hr_main_changeset->{postfix} : q~~);
127 1         4 return $self->_parse_changelogs($hr_main_changeset->{changelogs}, $s_changelog_root);
128             }
129              
130             1; # End of Geoffrey::Read
131              
132             __END__