view release on metacpan or  search on metacpan

lib/Carmel/App.pm  view on Meta::CPAN

    my $code = 0;
    try {
        $self->$call(@args);
    } catch {
        warn $_;
        $code = 1;
    };

    return $code;
}

sub repository_base {
    my $self = shift;

    my $home = $ENV{HOME} || $ENV{HOMEPATH};
    Path::Tiny->new($ENV{PERL_CARMEL_REPO} || "$home/.carmel/" . $self->perl_arch);
}

sub repo {
    my $self = shift;
    $self->{repo} ||= $self->build_repo;
}

sub build_repo {
    my $self = shift;
    Carmel::Repository->new(path => $self->repository_base->child('builds'));
}

sub cmd_help {
    my $self = shift;
    print "Carmel version $Carmel::VERSION\n\n";
    Pod::Usage::pod2usage(1);
}

sub cmd_version {
    my $self = shift;
    print "Carmel version $Carmel::VERSION\n";
}

sub cmd_inject {
    my($self, @args) = @_;
    $self->builder->install("--reinstall", @args);
}

sub cmd_pin {
    my($self, @args) = @_;
    die "carmel pin is deprecated. Use `carmel update @args` instead\n";
}

sub cmd_update {
    my($self, @args) = @_;

    my $snapshot = $self->snapshot
      or die "Can't run carmel update without snapshot. Run `carmel install` first.\n";

    print "---> Checking updates...\n";

    $self->update_or_install($snapshot, @args);
}

sub update_or_install {
    my($self, $snapshot, @args) = @_;

    my $builder = $self->builder;
    my $requirements = $self->requirements;

    my $check = sub {
        my($module, $pathname, $in_args, $version) = @_;

        return if $module eq 'perl';

        my $dist = $builder->search_module($module, $version);
        unless ($dist) {
            if ($version) {
                die "Can't find $module ($version) on CPAN\n";
            } else {
                # workaround bad main package e.g. LWP => libwww::perl
                warn "Can't find $module on CPAN\n";
                return;
            }
        }

        if ($dist->pathname ne $pathname && $snapshot) {
            $snapshot->remove_distributions(sub {
                my $dist = shift;
                $dist->provides_module($module);
            });
        }

        if (defined $version) {
            try {
                $requirements->add_string_requirement($module, $version);
            } catch {
                my($err) = /illegal requirements(?: .*?): (.*) at/;
                my $old = $requirements->requirements_for_module($module);
                die "Requested version for $module '$version' conflicts with version required in cpanfile '$old': $err\n";
            };
        } else {
            my $want_ver = $dist->version_for($module);
            try {
                $requirements->add_string_requirement($module, $want_ver);
            } catch {
                # there's an update but it conflicts with specs in cpanfile, ignoring
                if ($in_args) {
                    my($err) = /illegal requirements(?: .*?): (.*) at/;
                    my $old = $requirements->requirements_for_module($module);
                    die "The update for $module '$want_ver' conflicts with version required in cpanfile '$old' $err\n";
                }
            };
        }
    };

    if (@args) {
        for my $arg (@args) {
            my($module, $version) = split '@', $arg, 2;
            my $dist = $snapshot ? $snapshot->find($module) : undef;
            if ($dist) {
                $check->($module, $dist->pathname, 1, $version ? "== $version" : undef);
            } elsif (defined $requirements->requirements_for_module($module)) {
                $check->($module, '', 1, $version ? "== $version" : undef);
            } else {
                die "$module is not found in cpanfile or cpanfile.snapshot\n";
            }
        }
    } else {
        my $missing = $requirements->clone;

        my @checks;
        my $resolver = $self->resolver(
            root     => $self->requirements->clone,
            snapshot => $snapshot,
            found    => sub {
                my $artifact = shift;
                for my $pkg (keys %{$artifact->provides}) {
                    $missing->clear_requirement($pkg);
                }
                push @checks, [ $artifact->package, $artifact->install->{pathname}, 0 ];
            },
            missing  => sub {
                my($module, $want_version) = @_;
                $missing->add_string_requirement($module => $want_version);
            },
        );
        $resolver->resolve;

        # snapshot not supplied (first carmel install), or
        # specified in cpanfile but not in snapshot, possibly core module
        for my $module ($missing->required_modules) {
            push @checks, [ $module, '', 0 ];
        }

        progress \@checks, sub { $check->(@{$_[0]}) };
    }

    # rebuild the snapshot
    $self->update_dependencies($requirements, $snapshot);
}

sub cmd_install {
    my($self, @args) = @_;

    die "Usage: carmel install\n" if @args;

    my $snapshot = $self->snapshot;
    if ($snapshot) {
        $self->update_dependencies($self->requirements, $snapshot);
    } else {
        print "---> Installing modules...\n";
        $self->update_or_install($snapshot);
    }
}

sub update_dependencies {
    my($self, $root_reqs, $snapshot) = @_;

    my @artifacts = $self->install($root_reqs, $snapshot);
    $self->dump_bootstrap(\@artifacts);
    $self->save_snapshot(\@artifacts);
}

sub resolve_dependencies {
    my($self, $root_reqs, $missing, $snapshot) = @_;

    my @artifacts;
    $self->resolver(
        root     => $root_reqs,
        snapshot => $snapshot,
        found    => sub {
            my $artifact = shift;
            printf "Using %s (%s)\n", $artifact->package, $artifact->version || '0';
            push @artifacts, $artifact;
        },
        missing  => sub {
            my($module, $want_version) = @_;
            $missing->add_string_requirement($module => $want_version);
        },
    )->resolve;

    return @artifacts;
}

sub is_identical_requirement {
    my($self, $old, $new) = @_;

    return unless $old;

    # not super accurate but enough
    join(',', sort $old->required_modules) eq join(',', sort $new->required_modules);
}

sub try_install {
    my($self, $root_reqs, $snapshot) = @_;

    my $prev;
    while (1) {
        my $missing = CPAN::Meta::Requirements->new;
        my @artifacts = $self->resolve_dependencies($root_reqs, $missing, $snapshot);

        if (!$missing->required_modules) {
            return @artifacts;
        }

        if ($self->is_identical_requirement($prev, $missing)) {
            my $prereqs = $missing->as_string_hash;
            my $requirements = join ", ", map "$_ => @{[ $prereqs->{$_} || '0' ]}", keys %$prereqs;
            die "Can't find an artifact for $requirements\n" .
              "You need to run `carmel install` first to get the modules installed and artifacts built.\n";
        }

        $prev = $missing;

        my $cpanfile = Module::CPANfile->from_prereqs({
            runtime => {