File Coverage

blib/lib/Shipwright/Script/Relocate.pm
Criterion Covered Total %
statement 15 37 40.5
branch 0 16 0.0
condition 0 15 0.0
subroutine 5 7 71.4
pod 0 2 0.0
total 20 77 25.9


line stmt bran cond sub pod time code
1             package Shipwright::Script::Relocate;
2              
3 1     1   1138 use strict;
  1         2  
  1         29  
4 1     1   3 use warnings;
  1         2  
  1         20  
5 1     1   3 use Shipwright::Util;
  1         64  
  1         72  
6              
7 1     1   5 use base qw/App::CLI::Command Shipwright::Script/;
  1         1  
  1         101  
8              
9             __PACKAGE__->mk_accessors('as');
10              
11             sub options {
12 0     0 0   ( 'as=s' => 'as', );
13             }
14              
15 1     1   4 use Shipwright;
  1         1  
  1         5  
16              
17             sub run {
18 0     0 0   my $self = shift;
19 0           my ( $name, $new_source ) = @_;
20              
21 0 0         confess_or_die "need name arg" unless $name;
22 0 0         confess_or_die "need source arg" unless $new_source;
23              
24 0           my $shipwright = Shipwright->new(
25             repository => $self->repository,
26             source => $new_source,
27             );
28              
29 0           my $source = $shipwright->backend->source;
30 0           my $branches = $shipwright->backend->branches;
31              
32             # die if the specified branch doesn't exist
33 0 0 0       if ( $branches && $self->as ) {
34 0           confess_or_die "$name doesn't have branch "
35             . $self->as
36             . ". please use import cmd instead"
37 0 0         unless grep { $_ eq $self->as } @{ $branches->{$name} || [] };
  0 0          
38             }
39              
40 0 0         if ( exists $source->{$name} ) {
41 0 0 0       if (
      0        
      0        
42             (
43             ref $source->{$name}
44             && $source->{$name}{ $self->as || $branches->{$name}[0] } eq
45             $new_source
46             )
47             || $source->{$name} eq $new_source
48             )
49             {
50 0           $self->log->fatal(
51             "the new source is the same as old source, won't update"
52             );
53             }
54             else {
55 0 0         if ( ref $source->{$name} ) {
56 0           $source->{$name} = {
57 0   0       %{ $source->{$name} },
58             $self->as || $branches->{$name}[0] => $new_source
59             };
60             }
61             else {
62 0           $source->{$name} = $new_source;
63             }
64              
65 0           $shipwright->backend->source($source);
66 0           $self->log->fatal( "successfully relocated $name to $new_source" );
67             }
68             }
69             else {
70 0           $self->log->fatal( "haven't found $name in source.yml, won't relocate" );
71             }
72              
73             }
74              
75             1;
76              
77             __END__