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__ |