File Coverage

blib/lib/App/bif/new/project.pm
Criterion Covered Total %
statement 18 89 20.2
branch 0 20 0.0
condition 0 35 0.0
subroutine 6 10 60.0
pod 1 3 33.3
total 25 157 15.9


line stmt bran cond sub pod time code
1             package App::bif::new::project;
2 1     1   3126 use strict;
  1         2  
  1         26  
3 1     1   6 use warnings;
  1         1  
  1         38  
4 1     1   5 use Bif::Mo;
  1         2  
  1         7  
5 1     1   732 use IO::Prompt::Tiny qw/prompt/;
  1         647  
  1         75  
6 1     1   778 use DBIx::ThinSQL qw/ case qv sq/;
  1         28317  
  1         8  
7              
8             our $VERSION = '0.1.5_6';
9             extends 'App::bif';
10              
11             sub dup {
12 0     0 0 0 my $self = shift;
13 0         0 my $opts = $self->opts;
14 0         0 my $dbw = $self->dbw;
15              
16 0         0 my $path = $opts->{path};
17 0         0 my $dup_pinfo = $self->get_project( $opts->{dup} );
18              
19             $opts->{title} ||= $dbw->xval(
20             select => 'p.title',
21             from => 'projects p',
22             where => { 'p.id' => $dup_pinfo->{id} },
23 0   0     0 );
24              
25             my $src = $dbw->xval(
26             select => 'n.path',
27             from => 'projects p',
28             inner_join => 'nodes n',
29             on => 'n.id = p.id',
30             where => { 'p.id' => $dup_pinfo->{id} },
31 0         0 );
32              
33             $opts->{message} ||=
34 0   0     0 $self->prompt_edit( txt => "[ dup: $src ]\n", opts => $self );
35              
36             $dbw->txn(
37             sub {
38 0   0 0   0 $opts->{id} ||= $dbw->nextval('nodes');
39 0   0     0 $opts->{change_id} ||= $self->new_change;
40              
41             $dbw->xdo(
42             insert_into => 'func_new_project',
43             values => {
44             change_id => $opts->{change_id},
45             id => $opts->{id},
46             parent_id => $opts->{parent_id},
47             name => $opts->{name},
48             title => $opts->{title},
49             },
50 0         0 );
51              
52             $dbw->xdo(
53             update => 'projects',
54             set => { local => 1, },
55             where => { id => $opts->{id} },
56 0         0 );
57              
58             # TODO: unecessary?
59 0 0       0 if ( $dup_pinfo->{default_hub_id} ) {
60             $dbw->xdo(
61             insert_into => 'func_update_project',
62             values => {
63             id => $opts->{id},
64             change_id => $opts->{change_id},
65             hub_id => $dup_pinfo->{default_hub_id},
66             },
67 0         0 );
68             }
69              
70             my @status = $dbw->xhashrefs(
71             select => [ 'ps.status', 'ps.rank', 'p.id AS current_id' ],
72             from => 'project_status ps',
73             left_join => 'projects p',
74             on => 'p.project_status_id = ps.id',
75             where => { 'ps.project_id' => $dup_pinfo->{id} },
76 0         0 order_by => 'ps.rank',
77             );
78              
79 0         0 my $status_id;
80 0         0 foreach my $status (@status) {
81 0         0 my $sid = $dbw->nextval('nodes');
82 0 0       0 $status_id = $sid if $status->{current_id};
83              
84             $dbw->xdo(
85             insert_into => 'func_new_project_status',
86             values => {
87             change_id => $opts->{change_id},
88             id => $sid,
89             project_id => $opts->{id},
90             status => $status->{status},
91             rank => $status->{rank},
92             }
93 0         0 );
94             }
95              
96             $dbw->xdo(
97             insert_into => 'func_update_project',
98             values => {
99             id => $opts->{id},
100             change_id => $opts->{change_id},
101 0         0 project_status_id => $status_id,
102             },
103             );
104              
105             $dbw->xdo(
106             insert_into => [
107             'func_new_topic_status',
108             qw/change_id id project_id tkind status rank def/,
109             ],
110             select => [
111             qv( $opts->{change_id} ), 'nextval("nodes")',
112             qv( $opts->{id} ), 'ts.tkind',
113             'ts.status', 'ts.rank',
114             'ts.def',
115             ],
116             from => 'topic_status ts',
117             where => { 'ts.project_id' => $dup_pinfo->{id} },
118 0         0 order_by => [qw/ts.tkind ts.rank/]
119             );
120              
121             $self->end_change(
122             id => $opts->{change_id},
123             action_format =>
124             "new project $opts->{path} (%s) --dup $dup_pinfo->{path} (%s)]",
125             action_node_id_1 => $opts->{id},
126             action_node_id_1 => $dup_pinfo->{id},
127             message => $opts->{message},
128 0         0 );
129              
130             }
131 0         0 );
132              
133 0         0 return $self->ok('NewProject');
134             }
135              
136             sub new_project {
137 0     0 0 0 my $self = shift;
138 0   0     0 my $kind = shift || 'project';
139 0         0 my $dbw = $self->dbw;
140 0         0 my $opts = $self->opts;
141              
142             $dbw->xdo(
143             insert_into => 'func_new_project',
144             values => {
145             change_id => $opts->{change_id},
146             id => $opts->{id},
147             parent_id => $opts->{parent_id},
148             name => $opts->{name},
149             title => $opts->{title},
150             },
151 0         0 );
152              
153             $dbw->xdo(
154             update => 'projects',
155             set => {
156             local => 1,
157             },
158             where => { id => $opts->{id} },
159 0         0 );
160              
161 0         0 my @status = $dbw->xhashrefs(
162             select => [ qw/status rank/, ],
163             from => 'default_status',
164             where => { kind => $kind },
165             order_by => 'rank',
166             );
167              
168 0         0 foreach my $status (@status) {
169 0         0 my $sid = $dbw->nextval('nodes');
170              
171             $dbw->xdo(
172             insert_into => 'func_new_project_status',
173             values => {
174             change_id => $opts->{change_id},
175             id => $sid,
176             project_id => $opts->{id},
177             status => $status->{status},
178             rank => $status->{rank},
179             }
180 0         0 );
181             }
182              
183             $dbw->xdo(
184             insert_into =>
185             [ 'func_update_project', 'id', 'change_id', 'project_status_id', ],
186             select =>
187             [ qv( $opts->{id} ), qv( $opts->{change_id} ), 'project_status.id', ],
188             from => 'default_status',
189             inner_join => 'project_status',
190             on => {
191             project_id => $opts->{id},
192             'default_status.status' => \'project_status.status',
193             },
194 0         0 where => do {
195              
196 0 0       0 if ( $opts->{status} ) {
197             {
198             'default_status.kind' => 'project',
199             'default_status.status' => $opts->{status},
200 0         0 };
201             }
202             else {
203             {
204 0         0 'default_status.kind' => 'project',
205             'default_status.def' => 1,
206             };
207             }
208             },
209             );
210              
211             $dbw->xdo(
212             insert_into => [
213             'func_new_topic_status',
214             qw/change_id id project_id tkind status rank def/,
215             ],
216             select => [
217             qv( $opts->{change_id} ),
218             'nextval("nodes")',
219 0         0 qv( $opts->{id} ),
220             'ds.kind',
221             'ds.status',
222             'ds.rank',
223             case (
224             when => 'ds.def',
225             then => 1,
226             else => 0,
227             )->as('def'),
228             ],
229             from => 'default_status ds',
230             where => { 'ds.kind !' => [ 'project', 'hub' ] },
231             order_by => [qw/ds.kind ds.rank/]
232             );
233             }
234              
235             sub run {
236 1     1 1 1 my $self = shift;
237 1         5 my $opts = $self->opts;
238 1         9 my $dbw = $self->dbw;
239              
240             $dbw->txn(
241             sub {
242 0     0     my $start = time;
243 0           $self->stop_work(
244             stop => $start,
245             save => 1,
246             );
247              
248 0   0       $opts->{path} ||= prompt( 'Path:', '' )
      0        
249             || return $self->err( 'ProjectPathRequired',
250             'project path is required' );
251              
252 0           my @parts = split( '/', $opts->{path} );
253 0           $opts->{name} = pop @parts;
254              
255 0           my $parent = join( '/', @parts );
256 0           my @parents = $dbw->get_projects($parent);
257              
258 0 0         if ( @parents > 1 ) {
    0          
    0          
259             return $self->err( 'ParentProjectAmbiguous',
260             "parent path is ambiguous:\n "
261 0           . join( "\n ", map { $_->{path} } @parents ) );
  0            
262             }
263             elsif (@parents) {
264 0           $opts->{parent_id} = $parents[0]->{id};
265 0           @parts = split( '/', $parents[0]->{path} );
266             }
267             elsif (@parts) {
268 0           return $self->err( 'HubNotFound',
269             "hub or parent project not found: " . join( '/', @parts ) );
270             }
271              
272 0           my @x = $dbw->get_projects( $opts->{path} );
273 0 0         return $self->err( 'ProjectExists',
274             "project exists: $opts->{path}" )
275             if @x;
276              
277 0           my $where;
278 0 0         if ( $opts->{status} ) {
279             return $self->err( 'InvalidStatus',
280             'unknown status: ' . $opts->{status} )
281             unless $dbw->xarrayref(
282             select => 'count(*)',
283             from => 'default_status',
284             where => {
285             kind => 'project',
286             status => $opts->{status},
287             }
288 0 0         );
289             }
290              
291 0 0         return dup($self) if $opts->{dup};
292              
293 0   0       $opts->{title} ||= prompt( 'Title:', '' )
      0        
294             || return $self->err( 'ProjectTitleequired',
295             'project title is required' );
296              
297 0   0       $opts->{message} ||= $self->prompt_edit( opts => $self );
298 0   0       $opts->{lang} ||= 'en';
299 0   0       $opts->{id} ||= $dbw->nextval('nodes');
300 0   0       $opts->{change_id} ||= $self->new_change;
301              
302 0           $self->new_project;
303              
304             $self->start_work(
305             node_id => $opts->{id},
306 0           start => $start,
307             start_comment => "new project",
308             billable => 1,
309             );
310              
311 0           $self->stop_work(
312             stop => time,
313             restore => 1,
314             );
315              
316             $self->record_work(
317             node_id => $opts->{id},
318             change_id => $opts->{change_id}
319 0           );
320              
321             $self->end_change(
322             id => $opts->{change_id},
323             message => $opts->{message},
324             action_format => "new project $opts->{path} (%s)",
325             action_node_id_1 => $opts->{id},
326 0           );
327              
328             }
329 0           );
330              
331 0           return $self->ok('NewProject');
332             }
333              
334             1;
335             __END__