| 17 | 17 |
has name => (is => 'ro', isa => 'Str', required => 1);
|
| 18 | 18 |
has version => (is => 'ro', isa => 'Maybe[Str]', default => '0.01');
|
| 19 | 19 |
has abstract => (is => 'ro', isa => 'Str', default => 'a great new dist');
|
|
20 |
has cpan_author => (is => 'ro', isa => 'Maybe[Str]', default => 'LOCAL');
|
| 20 | 21 |
has archive_ext => (is => 'ro', isa => 'Str', default => 'tar.gz');
|
| 21 | 22 |
|
| 22 | 23 |
has archive_basename => (
|
|
| 88 | 89 |
return @modules;
|
| 89 | 90 |
}
|
| 90 | 91 |
|
|
92 |
sub _mk_container_path {
|
|
93 |
my ($self, $filename) = @_;
|
|
94 |
|
|
95 |
my (@parts) = File::Spec->splitdir($filename);
|
|
96 |
my $leaf_filename = pop @parts;
|
|
97 |
File::Path::mkpath(File::Spec->catdir(@parts));
|
|
98 |
}
|
|
99 |
|
| 91 | 100 |
sub make_dist_dir {
|
| 92 | 101 |
my ($self, $arg) = @_;
|
| 93 | 102 |
$arg ||= {};
|
|
| 97 | 106 |
|
| 98 | 107 |
for my $file ($self->files) {
|
| 99 | 108 |
my $fqfn = File::Spec->catfile($dist_dir, $file->filename);
|
| 100 | |
my (@parts) = File::Spec->splitdir($fqfn);
|
| 101 | |
my $leaf_filename = pop @parts;
|
| 102 | |
File::Path::mkpath(File::Spec->catdir(@parts));
|
|
109 |
$self->_mk_container_path($fqfn);
|
|
110 |
|
| 103 | 111 |
open my $fh, '>', $fqfn or die "couldn't open $fqfn for writing: $!";
|
| 104 | 112 |
print $fh $file->as_string;
|
| 105 | 113 |
close $fh or die "error when closing $fqfn: $!";
|
|
| 108 | 116 |
return $dist_dir;
|
| 109 | 117 |
}
|
| 110 | 118 |
|
|
119 |
sub _author_dir_infix {
|
|
120 |
my ($self) = @_;
|
|
121 |
|
|
122 |
Carp::croak "can't put archive in author dir with no author defined"
|
|
123 |
unless my $pauseid = $self->cpan_author;
|
|
124 |
|
|
125 |
# Sorta like pow- pow- power-wheels! -- rjbs, 2008-03-14
|
|
126 |
my ($pa, $p) = $pauseid =~ /^((.).)/;
|
|
127 |
return ($p, $pa, $pauseid);
|
|
128 |
}
|
|
129 |
|
|
130 |
sub archive_filename {
|
|
131 |
my ($self, $arg) = @_;
|
|
132 |
|
|
133 |
my $base = $self->archive_basename;
|
|
134 |
my $ext = $self->archive_ext;
|
|
135 |
|
|
136 |
return File::Spec->catfile(
|
|
137 |
($arg->{author_prefix} ? $self->_author_dir_infix : ()),
|
|
138 |
"$base.$ext",
|
|
139 |
);
|
|
140 |
}
|
|
141 |
|
| 111 | 142 |
sub make_archive {
|
| 112 | 143 |
my ($self, $arg) = @_;
|
| 113 | 144 |
$arg ||= {};
|
|
| 116 | 147 |
|
| 117 | 148 |
my $archive = Archive::Any::Create->new;
|
| 118 | 149 |
my $container = $self->archive_basename;
|
| 119 | |
my $ext = $self->archive_ext;
|
| 120 | 150 |
|
| 121 | 151 |
$archive->container($container);
|
| 122 | 152 |
|
|
| 124 | 154 |
$archive->add_file($file->filename, $file->as_string);
|
| 125 | 155 |
}
|
| 126 | 156 |
|
| 127 | |
my $archive_filename = File::Spec->catfile($dir, "$container.$ext");
|
|
157 |
my $archive_filename = File::Spec->catfile(
|
|
158 |
$dir,
|
|
159 |
$self->archive_filename({ author_prefix => $arg->{author_prefix} })
|
|
160 |
);
|
|
161 |
|
|
162 |
$self->_mk_container_path($archive_filename);
|
| 128 | 163 |
$archive->write_file($archive_filename);
|
| 129 | 164 |
|
| 130 | 165 |
return $archive_filename;
|