CPAN-Mini-Inject

 view release on metacpan or  search on metacpan

lib/CPAN/Mini/Inject.pm  view on Meta::CPAN

  close $fh;

  $self->_updperms( $modulelist_file );

  return $self;
}

sub _updperms {
  my ( $self, $file ) = @_;

  chmod oct( $self->config->get( 'dirmode' ) ) & 06666, $file
   if $self->config->get( 'dirmode' );
}

sub _optionchk {
  my ( $options, @list ) = @_;
  my @missing;

  for my $option ( @list ) {
    push @missing, $option
     unless defined $$options{$option};

t/add-multiple.t  view on Meta::CPAN

	subtest 'packages' => sub {
		my $file = '02packages.details.txt.gz';
		my $destination = catfile $modules_base, $file;
		my $rc = copy(
		  catfile( $t_local, 'CPAN', 'modules', "$file.original" ),
		  $destination
		);
		ok $rc, 'File::Copy worked';
		ok -e $destination, 'Copied packages file to temp_dir';
		ok chmod(0666, $destination), 'chmod packages to 0666';
		};

	subtest 'mailrc' => sub {
		my $file = '01mailrc.txt.gz';
		my $destination   = catfile $authors_base, $file;
		my $rc = copy(
		  catfile( $t_local, "$file.original" ),
		  $destination
		);
		ok $rc, 'File::Copy worked';
		ok -e $destination, 'Copied mailrc file to temp_dir';
		ok chmod(0666, $destination), 'chmod mailrc to 0666';
		};
	};

sub get_module_details {
	my( $dist_sources ) = @_;
	my @modules = (
		{
		module   => 'CPAN::Mini::Inject',
		authorid => 'SSORICHE',
		version  => '0.01',

t/exceptions.t  view on Meta::CPAN

			skip 'User is generally superuser under cygwin and can read', 1 if $^O eq 'cygwin';

			my $repo_dir = catfile $temp_dir, 'injects';
			ok make_path($repo_dir), "make_path for injects/ succeeded";

			my $tmp_config_file = catfile $temp_dir, 'bad_config';
			my $fh;
			if(open $fh, '>', $tmp_config_file) {
				print {$fh} "Hello";
				close $fh;
				chmod 0111, $tmp_config_file;
				is( mode($tmp_config_file), 0111, 'mode for config is 0111' );
				ok -e $tmp_config_file, 'config file exists';
				ok ! -r $tmp_config_file, 'config file is not readable';
				}
			else {
				fail("Could not create an unreadable file");
				}

			my $mcpi = $class->new;
			isa_ok $mcpi, $class;

			dies_ok { $mcpi->parsecfg($tmp_config_file) } 'unreadable file';
			like $@, qr/Could not read file/, 'exception has expected message';
			chmod 0644, $tmp_config_file;
			}
		};

	subtest 'no repo config' => sub {
		my $tmp_config_file = catfile $temp_dir, 'bad_config';
		subtest 'create no repo config file' => sub {
			my $fh;
			if(open $fh, '>', $tmp_config_file) {
				print {$fh} "local: t/local/CPAN\nremote: http://www.cpan.org\n";
				close $fh;

t/exceptions.t  view on Meta::CPAN

		};

	subtest 'read-only repo' => sub {
		SKIP: {
			skip 'this system does not do file modes', 3 unless has_modes();
			my $tmp_config_file = catfile $temp_dir, 'bad_config';

			my $repo_dir = catfile $temp_dir, 'read-only-injects';
			subtest 'create read-only repo dir' => sub {
				ok make_path($repo_dir), 'created repo dir';
				chmod 0555, $repo_dir;
				is mode($repo_dir), 0555, 'repo dir has mode 444';
				ok ! -w $repo_dir, 'repo dir is not writable';
				};

			subtest 'create read-only repo config file' => sub {
				my $fh;
				if(open $fh, '>', $tmp_config_file) {
				print {$fh} <<"HERE";
local: $temp_dir
remote: http://www.cpan.org

t/exceptions.t  view on Meta::CPAN

					  module   => 'CPAN::Mini::Inject',
					  authorid => 'SSORICHE',
					  version  => '0.01',
					  file     => 'test-0.01.tar.gz'
					);
				  }
				  'read-only repository';
				like $@, qr/cannot write to repository/, 'exception has expected message';
				};

			chmod 755, $repo_dir;
			};
		}
	};

subtest 'add exceptions' => sub {
	my $repo_dir = catfile $temp_dir, 'injects';
	subtest 'create repo dir' => sub {
		ok make_path($repo_dir), 'created repo dir' unless -d $repo_dir;
		chmod 0755, $repo_dir;
		is mode($repo_dir), 0755, 'repo dir has mode 444' if has_modes();
		ok -r $repo_dir, 'repo dir is readable';
		ok -w $repo_dir, 'repo dir is writable';
		};

	my $tmp_config_file = catfile $temp_dir, 'good_config';
	subtest 'create config file' => sub {
		my $fh;
		if(open $fh, '>', $tmp_config_file) {
			print {$fh} <<"HERE";

t/exceptions.t  view on Meta::CPAN

				file     => 't/local/mymodules/not-discoverable.tar.gz'
				);
			} 'Dies without module/version when not discoverable';
		};
	};

subtest 'remote problems' => sub {
	my $repo_dir = catfile $temp_dir, 'injects';
	subtest 'create repo dir' => sub {
		ok make_path($repo_dir), 'created repo dir' unless -d $repo_dir;
		chmod 0755, $repo_dir;
		is mode($repo_dir), 0755, 'repo dir has mode 755' if has_modes();
		ok -r $repo_dir, 'repo dir is readable';
		ok -w $repo_dir, 'repo dir is writable';
		};

	subtest 'unreachable remote' => sub {
		my $unreachable_host = 'com';
		my $url = 'http://$host/';

		my ($lookup_error, @result) = getaddrinfo $unreachable_host, 'http';

t/exceptions.t  view on Meta::CPAN

# writelist()
subtest 'writelist' => sub {
	SKIP: {
		skip 'User is superuser and can always write', 1 if $< == 0;
		skip 'User is generally superuser under cygwin and can write', 1 if $^O eq 'cygwin';

		my $repo_dir = catfile $temp_dir, 'injects';
		subtest 'create repo dir' => sub {
			ok make_path($repo_dir), 'created repo dir' unless -d $repo_dir;
			chmod 0555, $repo_dir;
			is mode($repo_dir), 0555, 'repo dir has mode 555';
			ok -r $repo_dir, 'repo dir is readable';
			ok ! -w $repo_dir, 'repo dir is not writable';
			};

		my $tmp_config_file = catfile $temp_dir, 'config';
		subtest 'create config file' => sub {
			my $fh;
			if(open $fh, '>', $tmp_config_file) {
				print {$fh} <<"HERE";

t/inject.t  view on Meta::CPAN

	subtest 'packages' => sub {
		my $file = '02packages.details.txt.gz';
		my $destination = catfile $modules_base, $file;
		my $rc = copy(
		  catfile( $t_local, 'CPAN', 'modules', "$file.original" ),
		  $destination
		);
		ok $rc, 'File::Copy worked';
		ok -e $destination, 'Copied packages file to temp_dir';
		ok chmod(0666, $destination), 'chmod packages to 0666';
		};

	subtest 'mailrc' => sub {
		my $file = '01mailrc.txt.gz';
		my $destination   = catfile $authors_base, $file;
		my $rc = copy(
		  catfile( $t_local, "$file.original" ),
		  $destination
		);
		ok $rc, 'File::Copy worked';
		ok -e $destination, 'Copied mailrc file to temp_dir';
		ok chmod(0666, $destination), 'chmod mailrc to 0666';
		};
	};

sub get_module_details {
	my( $dist_sources ) = @_;
	my @modules = (
		{
		module   => 'CPAN::Mini::Inject',
		authorid => 'SSORICHE',
		version  => '0.01',