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   12411 use strict;
  42         83  
  42         1105  
3 42     42   206 use warnings;
  42         85  
  42         1205  
4 42     42   199 use Bif::Mo;
  42         82  
  42         272  
5 42     42   18480 use Bif::DBW;
  42         149  
  42         390  
6 42     42   1595 use Config::Tiny;
  42         104  
  42         1065  
7 42     42   203 use Log::Any '$log';
  42         85  
  42         193  
8 42     42   5384 use Path::Tiny qw/path tempdir/;
  42         82  
  42         23678  
9              
10             our $VERSION = '0.1.5_7';
11             extends 'App::bif';
12              
13             has subref => ( is => 'ro', );
14              
15             sub run {
16 85     85 1 181 my $self = shift;
17 85         314 my $opts = $self->opts;
18              
19             return $self->err( 'DirExists', 'location exists: ' . $opts->{directory} )
20 85 100       792 if -e $opts->{directory};
21              
22 84         2164 $opts->{directory} = path( $opts->{directory} );
23 84         1928 $opts->{directory}->parent->mkpath;
24              
25             my $tempdir = tempdir(
26             CLEANUP => !$opts->{debug},
27             DIR => $opts->{directory}->parent,
28 84         11936 TEMPLATE => 'bif-new-repo-XXXXXX',
29             );
30 84         51492 $log->debug( 'init: tmpdir ' . $tempdir );
31              
32 84         2500 $self->repo($tempdir);
33              
34             # Fake App::bif into thinking the database already exists
35 84         568 $tempdir->child( $self->dbfile( $self->DBVERSION ) )->touch;
36 84         23366 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         225 eval {
45             $dbw->txn(
46             sub {
47 84     84   52777 $|++;
48 84         942 printf "Creating repository: %s ", $opts->{directory};
49              
50 84         5721 my ( $old, $new ) = $dbw->deploy( $self->DBVERSION );
51 84         28207018 printf "(v%d.%d)\n", $self->DBVERSION, $new;
52              
53 84 100       887 $self->subref->( $self, $self->DBVERSION, $new )
54             if $self->subref;
55             }
56 84         1200 );
57             };
58              
59 84 100       258490 if ( my $err = $@ ) {
60 40         5222 $dbw->disconnect;
61 40         7760 Carp::croak $err;
62             }
63 44         59403 $dbw->disconnect;
64              
65 44 100       331 if ( $opts->{config} ) {
66 40         557 my $conf = Config::Tiny->new;
67              
68             $conf->{'user.alias'}->{ls} =
69 40         524 'list topics --status open --project-status run';
70             $conf->{'user.alias'}->{lss} =
71 40         140 'list topics --status open --status stalled --project-status run';
72 40         132 $conf->{'user.alias'}->{l} = 'list projects define plan run';
73 40         122 $conf->{'user.alias'}->{lsi} = 'list identities';
74              
75 40         371 $conf->write( $tempdir->child('config') );
76             }
77              
78             # Mark this as a repo for convenience
79 44         29500 $tempdir->child('.bif')->touch;
80              
81             $tempdir->move( $opts->{directory} )
82 44 50       12812 || return $self->err( 'Rename',
83             "rename $tempdir $opts->{directory}: $!" );
84              
85             # Rebuild the dbw for further commands?
86 44         4245 $self->repo( $opts->{directory} );
87 44         455 $self->dbw( $self->_build_dbw );
88              
89 44         467 return $self->ok('NewRepo');
90             }
91              
92             1;
93             __END__