view release on metacpan or  search on metacpan

bin/cpant  view on Meta::CPAN

  Copyright 2012-2013 Toby Inkster.
  
  The standalone executable contains the following modules embedded.
  
  =over 4
  
  =item L<App::cpanminus::script> Copyright 2010- Tatsuhiko Miyagawa
  
  =item L<CPAN::DistnameInfo> Copyright 2003 Graham Barr
  
  =item L<Parse::CPAN::Meta> Copyright 2006-2009 Adam Kennedy
  
  =item L<local::lib> Copyright 2007-2009 Matt S Trout
  
  =item L<HTTP::Tiny> Copyright 2011 Christian Hansen
  
  =item L<Module::Metadata> Copyright 2001-2006 Ken Williams. 2010 Matt S Trout
  
  =item L<version> Copyright 2004-2010 John Peacock
  
  =item L<JSON::PP> Copyright 2007−2011 by Makamaka Hannyaharamitu
  
  =item L<CPAN::Meta> Copyright (c) 2010 by David Golden and Ricardo Signes
  
  =item L<Try::Tiny> Copyright (c) 2009 Yuval Kogman
  
  =item L<parent> Copyright (c) 2007-10 Max Maischein
  
  =item L<Version::Requirements> copyright (c) 2010 by Ricardo Signes
  
  =item L<CPAN::Meta::YAML> copyright (c) 2010 by Adam Kennedy
  
  =back
  
  =head1 LICENSE
  
  Same as Perl.
  
  =cut
  
  1;
APP_CPANTIMES

$fatpacked{"App/cpantimes/script.pm"} = <<'APP_CPANTIMES_SCRIPT';
  package App::cpantimes::script;
  
  our $VERSION = "1.502101";
  
  use 5.008;
  use strict;
  use base 'App::cpanminus::script';
  
  my $HOME =
  	defined $ENV{HOME}     ? $ENV{HOME} :
  	defined $ENV{APPDATA}  ? $ENV{APPDATA} :
  	die("Could not determine home directory!");
  
  sub new
  {
  	my ($class, @args) = @_;
  	my $self = $class->SUPER::new(@args);
  	
  	$self->{_metabase_api}  = 'https://metabase.cpantesters.org/api/v1/';
  	$self->{_metabase_file} = "File::Spec"->catfile(
  		$HOME,
  		qw< .cpantesters metabase_id.json >,
  	);
  
  	eval {
  		require Test::Reporter;
  		require Test::Reporter::Transport::Metabase;
  		require LWP::Protocol::https;
  		-r $self->{_metabase_file};
  	} or warn <<"WARNING";
  
  *** WARNING ***
  You are using cpantimes, a modified version of cpanminus with CPAN testers
  support, but it is not correctly configured. Please ensure Test::Reporter,
  Test::Reporter::Transport::Metabase and LWP::Protocol::https are installed,
  and use the `metabase-profile` tool to create Metabase login details as
  "$self->{_metabase_file}".
  
  Installation will now continue as normal, but test reports will NOT be
  sent!
  
  WARNING
  
  	return $self;
  }
  
  # Need to clear _current_dist before each installation, to ensure reports
  # don't get sent based on incorrect info.
  sub install_module
  {
  	my ($self, @args) = @_;
  	delete $self->{_current_dist};
  	$self->SUPER::install_module(@args);
  }
  
  sub resolve_name
  {
  	my ($self, @args) = @_;
  	my $dist = $self->SUPER::resolve_name(@args);
  	$self->{_current_dist} = $dist;
  	return $dist;
  }
  
  sub cpants_report
  {	
  	my ($self, $grade, $distname) = @_;
  	eval {
  		require Test::Reporter;
  		require Test::Reporter::Transport::Metabase;
  		require LWP::Protocol::https;
  		-r $self->{_metabase_file} and exists $self->{_current_dist}{filename};
  	} or return;
  	
  	my $report = <<"REPORT";
  $distname ... @{[ uc $grade ]}
  
  Perl           : $^V
  System         : $^O
  Local Versions :
  REPORT
  
  	for my $mod (keys %{ $self->{local_versions} }) {
  		$report .= sprintf("    %-32s : %s\n", $mod, $self->{local_versions}{$mod});
  	}
  	$report .= "\n";
  	
  	$report .= "Test Output    :\n\n";
  	$report .= do {
  		open my $log, '<', $self->{log};
  		local $/ = <$log>;
  	};
  	$report .= "\n";
  
  	my $Report = "Test::Reporter"->new(
  		transport      => 'Metabase',
  		transport_args => [
  			uri     => $self->{_metabase_api},
  			id_file => $self->{_metabase_file},
  		],
  		distribution   => $distname,
  		distfile       => sprintf(
  			'%s/%s',
  			$self->{_current_dist}{cpanid},
  			$self->{_current_dist}{filename},
  		),
  		grade          => $grade,
  		from           => 'null@invalid.invalid',
  		comments       => $report,
  	);
  
  	$Report->send;
  	warn $Report->errstr if $Report->errstr;
  }
  
  sub test
  {
  	my($self, $cmd, $distname) = @_;
  	return 1 if $self->{notest};