view release on metacpan or  search on metacpan

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

}

sub run_with_server {
  my ($app, $run, $pan, @args) = @_;
  unless (
    defined($pan) and $pan =~ /^--(combined|nopin|autopin)$/
  ) {
    unshift @args, grep defined, $pan;
    $pan = '--combined';
  }
  $pan =~ s/^--//;
  require Mojo::IOLoop::Server;
  my $port = Mojo::IOLoop::Server->generate_port;
  my $url = "http://localhost:${port}/";
  my $pid = fork();
  die "fork() fork()ed up: $!" unless defined $pid;
  unless ($pid) {
    $ENV{OPAN_AUTOPIN} = 1 if $pan eq 'autopin';
    $app->start(daemon => -l => $url);
    exit(0);
  }
  eval { $run->("${url}${pan}", @args) };
  my $err = $@;
  kill TERM => $pid;
  warn "Run block failed: $err" if $err;
}

sub do_cpanm {
  my ($app, @args) = @_;
  run_with_server($app, sub {
    my ($mirror, @args) = @_;
    system(cpanm => '--mirror', $mirror, '--mirror-only', @args);
  }, @args);
}

sub do_carton {
  my ($app, @args) = @_;
  run_with_server($app, sub {
    my ($mirror, @args) = @_;
    local $ENV{PERL_CARTON_MIRROR} = $mirror;
    system(carton => @args);
  }, @args);
}

foreach my $cmd (
  qw(init fetch add unadd pin unpin merge pull purgelist purge cpanm carton)
) {
  my $pkg = "App::opan::Command::${cmd}";
  my $code = __PACKAGE__->can("do_${cmd}");
  Mojo::Base->import::into($pkg, 'Mojolicious::Command');
  monkey_patch $pkg, description => sub { pod_section($cmd, 1) };
  monkey_patch $pkg, usage => sub { pod_section($cmd, 0) };
  monkey_patch $pkg,
    run => sub { my $self = shift; $code->($self->app, @_) };
}

use Mojolicious::Lite;

Mojo::IOLoop->recurring(600 => sub { do_pull(app); }) if $ENV{OPAN_RECURRING_PULL};

post "/upload" => sub {
  my $c = shift;
  unless ($TOKENS{$c->req->url->to_abs->password || ""}) {
    $c->res->headers->www_authenticate("Basic realm=opan");
    return $c->render(status => 401, text => "Token missing or not found\n");
  }
  my $upload = $c->req->upload('dist') || $c->req->upload('pause99_add_uri_httpupload')
    or return $c->render(status => 400, text => "dist file missing\n");
  my $pan_dir = path('pans/custom/dists/M/MY/MY')->make_path;
  $upload->move_to(my $pan_path = $pan_dir->child($upload->filename))
    or $c->render(
    status => 500,
    text   => "Failed to move ${upload} into custom pan: $!\n"
    );
  add_dist_to_index('pans/custom/index', $pan_path);
  do_merge(app);
  $c->render(text => "$pan_path Added to opan\n");
};

push(@{app->commands->namespaces}, 'App::opan::Command');

helper cpan_url => sub { Mojo::URL->new($ENV{OPAN_MIRROR} || 'https://www.cpan.org/') };

my $nopin_static = Mojolicious::Static->new(
  paths => [ 'pans/custom/dists' ]
);

my $pinset_static = Mojolicious::Static->new(
  paths => [ 'pans/pinset/dists' ]
);

my $combined_static = Mojolicious::Static->new(
  paths => [ 'pans/custom/dists', 'pans/pinset/dists' ]
);

my $base_static = Mojolicious::Static->new(
  paths => [ 'pans' ]
);

foreach my $pan (qw(upstream nopin combined pinset custom)) {
  get "/${pan}/modules/02packages.details.txt" => sub {
    $base_static->dispatch($_[0]->stash(path => "${pan}/index"));
  };
  get "/${pan}/modules/02packages.details.txt.gz" => sub {
    $base_static->dispatch($_[0]->stash(path => "${pan}/index.gz"));
  };
}

my $serve_upstream = sub {
  my ($c) = @_;
  $c->render_later;
  $c->ua->get(
    $c->cpan_url.'authors/id/'.$c->stash->{dist_path},
      sub {
      my (undef, $tx) = @_;
        $c->tx->res($tx->res);
      $c->rendered;
    }
  );
  return;
};

get '/upstream/authors/id/*dist_path' => $serve_upstream;

get '/combined/authors/id/*dist_path' => sub {
  $_[0]->stash(path => $_[0]->stash->{dist_path});
  $combined_static->dispatch($_[0]) or $serve_upstream->($_[0]);
};

get '/nopin/authors/id/*dist_path' => sub {
  $_[0]->stash(path => $_[0]->stash->{dist_path});
  $nopin_static->dispatch($_[0]) or $serve_upstream->($_[0]);
};

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

=head3 carton

  opan carton install

Starts a temporary server process and runs carton.

  PERL_CARTON_MIRROR=http://localhost:<port>/combined/ carton <your args here>

Can also be run with one of:

  opan carton --nopin <your args here>
  opan carton --autopin <your args here>
  opan carton --combined <your args here>

to request a specific PAN.

=head2 PANs

=head3 upstream

02packages: Fetched from www.cpan.org by the L</fetch> command.

Dist files: Fetched from www.cpan.org on-demand.

=head3 pinset

02packages: Managed by L</pin> and L</unpin> commands.

Dist files: Fetched from www.cpan.org by L</pin> command.

=head3 custom

02packages: Managed by L</add> and L</unadd> commands.

Dist files: Imported from local disk by L</add> command.

=head3 combined

02packages: Merged from upstream, pinset and custom PANs by L</merge> command.

Dist files: Fetched from custom, pinset and upstream in that order.

=head3 nopin

02packages: Merged from upstream and custom PANs by L</merge> command.

Dist files: Fetched from custom, pinset and upstream in that order.

=head3 autopin

Virtual PAN with no presence on disk.

Identical to nopin, but fetching a dist from upstream does an implict L</pin>.

Since this can modify your opan config, it's only enabled if the environment
variable C<OPAN_AUTOPIN> is set to a true value (calling the L</cpanm> or
L</carton> commands with C<--autopin> sets this for you, because you already
specified you wanted that).

=head2 uploads

To enable the /upload endpoint, set the ENV var OPAN_AUTH_TOKENS to a colon
separated list of accepted tokens for uploads. This will allow a post with a
'file' upload argument, checking http basic auth password against the provided
auth tokens.

=head2 recurring pull

Set ENV OPAN_RECURRING_PULL to a true value to make opan automatically pull
from upstream every 600 seconds

=head2 custom upstream

Set the ENV var OPAN_MIRROR to specify a cpan mirror - the default is
www.cpan.org. Remember that if you need to temporarily overlay your overlay
but only for one user, there's nothing stopping you setting OPAN_MIRROR to
another opan.

=head1 AUTHOR

Matt S. Trout (mst) <mst@shadowcat.co.uk>

=head1 CONTRIBUTORS

Aaron Crane (arc) <arc@cpan.org>

Marcus Ramburg (marcus) <marcus.ramberg@gmail.com>

=head1 COPYRIGHT

Copyright (c) 2016-2018 the L<App::opan> L</AUTHOR> and L</CONTRIBUTORS>
as listed above.

=head1 LICENSE

This library is free software and may be distributed under the same terms
as perl itself.

=cut