File Coverage

blib/lib/App/bif/new/repo.pm
Criterion Covered Total %
statement 54 54 100.0
branch 9 10 90.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 73 74 98.6


line stmt bran cond sub pod time code
1             package App::bif::new::repo;
2 42     42   11351 use strict;
  42         83  
  42         1138  
3 42     42   213 use warnings;
  42         78  
  42         1090  
4 42     42   272 use Bif::Mo;
  42         70  
  42         254  
5 42     42   18683 use Bif::DBW;
  42         315  
  42         399  
6 42     42   1580 use Config::Tiny;
  42         90  
  42         1071  
7 42     42   270 use Log::Any '$log';
  42         83  
  42         199  
8 42     42   5678 use Path::Tiny qw/path tempdir/;
  42         100  
  42         23957  
9              
10             our $VERSION = '0.1.5_6';
11             extends 'App::bif';
12              
13             has subref => ( is => 'ro', );
14              
15             sub run {
16 85     85 1 176 my $self = shift;
17 85         325 my $opts = $self->opts;
18              
19             return $self->err( 'DirExists', 'location exists: ' . $opts->{directory} )
20 85 100       806 if -e $opts->{directory};
21              
22 84         2332 $opts->{directory} = path( $opts->{directory} );
23 84         1932 $opts->{directory}->parent->mkpath;
24              
25             my $tempdir = tempdir(
26             CLEANUP => !$opts->{debug},
27             DIR => $opts->{directory}->parent,
28 84         12399 TEMPLATE => 'bif-new-repo-XXXXXX',
29             );
30 84         51270 $log->debug( 'init: tmpdir ' . $tempdir );
31              
32 84         2594 $self->repo($tempdir);
33              
34             # Fake App::bif into thinking the database already exists
35 84         541 $tempdir->child( $self->dbfile( $self->DBVERSION ) )->touch;
36 84         24606 my $dbw = $self->dbw;
37              
38             # On windows at least, an SQLite handle on the database prevents a
39             # rename or temp directory removal. Unfortunately, doing the
40             # eval/disconnect check below results in the "uncleared implementors
41             # data" warning on error. For the moment I would prefer the warning
42             # than have the user left with a temporary directory to clean up.
43              
44 84         213 eval {
45             $dbw->txn(
46             sub {
47 84     84   53464 $|++;
48 84         927 printf "Creating repository: %s ", $opts->{directory};
49              
50 84         6318 my ( $old, $new ) = $dbw->deploy( $self->DBVERSION );
51 84         29336218 printf "(v%d.%d)\n", $self->DBVERSION, $new;
52              
53 84 100       919 $self->subref->( $self, $self->DBVERSION, $new )
54             if $self->subref;
55             }
56 84         1213 );
57             };
58              
59 84 100       334561 if ( my $err = $@ ) {
60 40         3867 $dbw->disconnect;
61 40         8007 Carp::croak $err;
62             }
63 44         60190 $dbw->disconnect;
64              
65 44 100       326 if ( $opts->{config} ) {
66 40         584 my $conf = Config::Tiny->new;
67              
68             $conf->{'user.alias'}->{ls} =
69 40         693 'list topics --status open --project-status run';
70             $conf->{'user.alias'}->{lss} =
71 40         141 'list topics --status open --status stalled --project-status run';
72 40         141 $conf->{'user.alias'}->{l} = 'list projects define plan run';
73 40         117 $conf->{'user.alias'}->{lsi} = 'list identities';
74              
75 40         781 $conf->write( $tempdir->child('config') );
76             }
77              
78             # Mark this as a repo for convenience
79 44         31065 $tempdir->child('.bif')->touch;
80              
81             $tempdir->move( $opts->{directory} )
82 44 50       12997 || return $self->err( 'Rename',
83             "rename $tempdir $opts->{directory}: $!" );
84              
85             # Rebuild the dbw for further commands?
86 44         4230 $self->repo( $opts->{directory} );
87 44         449 $self->dbw( $self->_build_dbw );
88              
89 44         450 return $self->ok('NewRepo');
90             }
91              
92             1;
93             __END__