view release on metacpan or  search on metacpan

lib/Shipwright/Script/Update.pm  view on Meta::CPAN

                $refs->{$dep}++;
                $shipwright->backend->refs($refs);
            }
        }
    }
    elsif ( $self->delete_deps ) {
        my @deps = split /\s*,\s*/, $self->delete_deps;
        my $name = shift or confess_or_die 'need name arg';
        my $requires = $shipwright->backend->requires( name => $name ) || {};
        my $deleted;
        for my $dep ( @deps ) {
            for my $type ( qw/requires build_requires recommends test_requires/ ) {
                if ( $requires->{$type} && exists $requires->{$type}{$dep} ) {
                    delete $requires->{$type}{$dep};
                    $deleted = 1;
                }
            }

            $shipwright->backend->_yml( "/scripts/$name/require.yml", $requires );
            my $refs = $shipwright->backend->refs;
            $refs->{$dep}-- if $refs->{$dep} > 0;
            $shipwright->backend->refs($refs);
        }
        if ( $deleted ) {
            $self->log->fatal( 'successfully updated' );
        }
        else {
            $self->log->fatal( "not updated: no such deps in $name" );
        }
        return;
    }
    else {
        $map    = $shipwright->backend->map    || {};
        $source = $shipwright->backend->source || {};
        $branches = $shipwright->backend->branches;

        if ( $self->all ) {
            confess_or_die '--all can not be specified with --as or NAME'
              if @_ || $self->as;

            my $dists = $shipwright->backend->order || [];
            for (@$dists) {
                $self->_update($_);
            }
        }
        else {
            my $name = shift;
            confess_or_die "need name arg\n" unless $name;

            # die if the specified branch doesn't exist
            if ( $branches && $self->as ) {
                confess_or_die "$name doesn't have branch "
                  . $self->as
                  . ". please use import cmd instead"
                  unless grep { $_ eq $self->as } @{ $branches->{$name} || [] };
            }

            my $new_source = shift;
            if ($new_source) {
                system(
                        "$0 relocate -r " 
                      . $self->repository
                      . (
                        $self->log_level
                        ? ( " --log-level " . $self->log_level )
                        : ''
                      )
                      . (
                        $self->log_file ? ( " --log-file " . $self->log_file )
                        : ''
                      )
                      . (
                        $self->as ? ( " --as " . $self->as )
                        : ''
                      )
                      . " $name $new_source"
                ) && die "relocate $name to $new_source failed: $!";
                # renew our $source
                $source = $shipwright->backend->source || {};
            }

            my @dists;
            if ( $self->follow ) {
                my (%checked);
                my $find_deps;
                $find_deps = sub {
                    my $name = shift;
                    return if $checked{$name}++;

                    my ($require) =
                      $shipwright->backend->requires( name => $name );
                    for my $type (
                        qw/requires build_requires recommends
                        test_requires/
                      )
                    {
                        for ( keys %{ $require->{$type} } ) {
                            $find_deps->($_);
                        }
                    }
                };

                $find_deps->($name);
                @dists = keys %checked;
            }
            else {
                @dists = $name;
            }

            for (@dists) {
                if ( $self->only_sources ) {
                    if ( $_ eq $name ) {
                        $self->_update( $_, $self->version, $self->as );
                    }
                    else {
                        $self->_update($_);
                    }
                }
                else {
                    local $ENV{SHIPWRIGHT_SOURCE_ROOT} = tempdir(
                        'shipwright_source_XXXXXX',
                        CLEANUP => 1,
                        TMPDIR  => 1
                    );
                    system(
                            "$0 import -r " 
                          . $self->repository
                          . (
                            $self->log_level
                            ? ( " --log-level " . $self->log_level )
                            : ''
                          )
                          . (
                            $self->log_file
                            ? ( " --log-file " . $self->log_file )
                            : ''
                          )