Commits

Toby Inkster committed 1b0fde8

provide some infrastructure stuff for command plugins to create tempdirs, keep caches, read/write config

  • Participants
  • Parent commits f98963a

Comments (0)

Files changed (7)

File lib/P5U/Command.pm

+package P5U::Command;
+
+use 5.010;
+use strict;
+use App::Cmd::Setup-command;
+
+use File::HomeDir qw<>;
+use File::Temp qw<>;
+use JSON qw<>;
+use Path::Class qw<>;
+
+my %config;
+
+sub get_tempdir
+{
+	Path::Class::Dir::->new(File::Temp::->newdir);
+}
+
+sub _get_distdatadir
+{
+	File::HomeDir::->my_dist_data('P5U') //
+	Path::Class::Dir::->new(File::HomeDir::->my_home => qw(perl5 utils data))->stringify
+}
+
+sub _get_distconfigdir
+{
+	File::HomeDir::->my_dist_data('P5U') //
+	Path::Class::Dir::->new(File::HomeDir::->my_home => qw(perl5 utils etc))->stringify
+}
+
+sub get_cachedir
+{
+	my $self = shift;
+	my $d = Path::Class::Dir::->new(
+		$self->_get_distdatadir,
+		(($self->command_names)[0]),
+		'cache',
+	);
+	$d->mkpath;
+	return $d;
+}
+
+sub get_datadir
+{
+	my $self = shift;
+	my $d = Path::Class::Dir::->new(
+		$self->_get_distdatadir,
+		(($self->command_names)[0]),
+		'store',
+	);
+	$d->mkpath;
+	return $d;
+}
+
+sub get_configfile
+{
+	my $self = shift;
+	my $f = Path::Class::File::->new(
+		$self->_get_distconfigdir,
+		(($self->command_names)[0]),
+		'config.json',
+	);
+}
+
+sub get_config
+{
+	my $proto = shift;
+	my $class = ref($proto) || $proto;
+	
+	unless ($config{$class})
+	{
+		$config{$class} =
+			eval { JSON::->new->decode(scalar $proto->get_configfile->slurp) }
+			|| +{};
+	}
+	
+	$config{$class};
+}
+
+sub save_config
+{
+	my $proto  = shift;
+	my $class  = ref($proto) || $proto;
+	my $config = $config{$class} || +{};
+	
+	my $fh = $proto->get_configfile->openw;
+	print $fh $config;
+}
+
+1;
+

File lib/P5U/Command/DebianRelease.pm

 	$self->usage_error("Cannot request both author and distribution report.")
 		if $opt->{author} && $opt->{distribution};
 	
-	my $helper = P5U::Lib::DebianRelease::->new;
+	my $helper = P5U::Lib::DebianRelease::->new(
+		cache_file  => $self->get_cachedir->file('allpackages.cache'),
+	);
 	
 	if ($opt->{author})
 		{ print $helper->author_report($_) for @$args }

File lib/P5U/Command/Reprove.pm

 		
 	P5U::Lib::Reprove::
 		-> new(
-			maybe author  => $opt->{author},
-			maybe module  => $opt->{module},
-			maybe release => $opt->{release},
-			maybe version => $opt->{version},
-			maybe verbose => $opt->{verbose},
+			maybe author      => $opt->{author},
+			maybe module      => $opt->{module},
+			maybe release     => $opt->{release},
+			maybe version     => $opt->{version},
+			maybe verbose     => $opt->{verbose},
+			      working_dir => $self->get_tempdir,
 		)
 		-> run;
 }

File lib/P5U/Command/Testers.pm

 	$distro =~ s{::}{-}g;
 	
 	my $helper = P5U::Lib::Testers::->new(
-				distro  =>   $distro,
-				os_data => !!$opt->{os_data},
-				stable  => !!$opt->{stable},
-		maybe version =>   $opt->{version},
+		      distro    =>   $distro,
+		      os_data   => !!$opt->{os_data},
+		      stable    => !!$opt->{stable},
+		maybe version   =>   $opt->{version},
+		      cache_dir =>   $self->get_cachedir->stringify,
 	);
 	
 	if ($opt->{summary})

File lib/P5U/Lib/DebianRelease.pm

 };
 
 use Any::Moose       0;
-use File::Slurp      0     qw< read_file >;
 use IO::Uncompress::Gunzip qw< gunzip $GunzipError >;
 use JSON             2.00  qw< from_json >;
 use LWP::Simple      0     qw< get >;
-use namespace::clean;
 use Object::AUTHORITY qw/AUTHORITY/;
 
-my $cachef = "/tmp/allpackages.cache";
 my $json   = JSON::->new->allow_nonref;
 
 sub dist2deb
 	"lib".lc($dist)."-perl";
 }
 
+use namespace::clean;
+
 has debian => (
-	is       => 'ro',
-	isa      => 'HashRef',
-	lazy     => 1,
-	builder  => '_build_debian',
+	is         => 'ro',
+	isa        => 'HashRef',
+	lazy_build => 1,
+);
+
+has cache_file => (
+	is         => 'ro',
+	required   => 1,
 );
 
 sub _build_debian
 {
+	my $self = shift;
 	my %pkgs;
-	unless ((-f $cachef) && (-M _) < 7)
+	unless ((-f $self->cache_file) && (-M _) < 7)
 	{
 		my $res = get "http://packages.debian.org/unstable/allpackages?format=txt.gz";
-		gunzip(\$res => $cachef) or die "gunzip failed: $GunzipError\n";
+		gunzip(\$res => $self->cache_file->stringify)
+			or die "gunzip failed: $GunzipError\n";
 	}
-	for (read_file $cachef)
+	for ($self->cache_file->slurp)
 	{
 		next unless /^(lib\S+-perl) \((\S+?)\)/;
 		$pkgs{$1} = $2;

File lib/P5U/Lib/Reprove.pm

 use App::Prove qw//;
 use Class::Load qw/load_class/;
 use JSON qw/from_json/;
-use File::Basename qw/fileparse/;
 use File::pushd qw/pushd/;
-use File::Path qw/make_path/;
-use File::Spec qw//;
 use File::Temp qw//;
+use Path::Class qw//;
 use LWP::Simple qw/get/;
 use Module::Manifest qw//;
 use Object::AUTHORITY qw/AUTHORITY/;
 
 has testdir => (
 	is         => 'ro',
-	isa        => 'File::Temp::Dir',
+	isa        => 'Path::Class::Dir',
+	lazy_build => 1,
+);
+
+has working_dir => (
+	is         => 'ro',
+	isa        => 'Path::Class::Dir',
 	lazy_build => 1,
 );
 
 sub _build_manifest
 {
 	my $self = shift;
-	my $fh = File::Temp->new;
+	my $fh = $self->working_dir->file('MANIFEST')->openw;
 	binmode( $fh, ":utf8");
 	$self->_getfile_to_handle('MANIFEST', $fh);
 	close $fh;
 	
 	my $manifest = Module::Manifest->new;
-	$manifest->open(manifest => $fh->filename);
+	$manifest->open(manifest => $self->working_dir->file('MANIFEST')->stringify);
 	return [ $manifest->files ];
 }
 
 sub _build_testdir
 {
-	my $self = shift;
-	my $testdir = File::Temp->newdir;
+	my $self    = shift;
+	my $testdir = $self->working_dir->subdir('t');
+	$testdir->mkpath;
 	
 	foreach my $file ($self->test_files)
 	{
-		my $dest = File::Spec->catfile($testdir->dirname, $file);
-		
-		my (undef, $d, undef) = fileparse($dest);
-		make_path($d);
-		
-		open my $fh, '>', $dest;
-		$self->_getfile_to_handle($file, $fh);
-		close $fh;
+		my $dest = $testdir->file($file);
+		$dest->dir->mkpath;
+		$self->_getfile_to_handle($file, $dest->openw);
 	}
 	
 	return $testdir;
 }
 
+sub _build_working_dir
+{
+	my $self = shift;
+	Path::Class::Dir::->new(
+		File::Temp::->newdir,
+	);
+}
+
 sub _app_prove_args
 {
 	't';
 {
 	my $self = shift;
 	printf("Reproving %s/%s (%s)\n", $self->release, $self->version, uc $self->author);
-	printf("Using temp dir '%s'\n", $self->testdir->dirname) if $self->verbose;
-	my $chdir = pushd($self->testdir->dirname);
+	printf("Using temp dir '%s'\n", $self->testdir) if $self->verbose;
+	my $chdir = pushd($self->testdir);
 	my $app   = App::Prove->new;
 	$app->process_args($self->_app_prove_args);
 	$app->verbose(1) if $self->verbose;

File meta/makefile.ttl

 	:requires           "App::Cmd";
 	:requires           "autodie";
 	:requires           "Class::Load";
+	:requires           "File::HomeDir";
 	:requires           "File::Path";
 	:requires           "File::pushd";
 	:requires           "File::Slurp";