File Coverage

blib/lib/Module/Faker/Dist.pm
Criterion Covered Total %
statement 194 214 90.6
branch 25 54 46.3
condition 14 23 60.8
subroutine 41 43 95.3
pod 5 9 55.5
total 279 343 81.3


line stmt bran cond sub pod time code
1             package Module::Faker::Dist;
2             # ABSTRACT: a fake CPAN distribution
3             $Module::Faker::Dist::VERSION = '0.022';
4 8     8   535676 use Moose;
  8         3147973  
  8         53  
5              
6 8     8   62011 use Module::Faker::File;
  8         26  
  8         318  
7 8     8   3769 use Module::Faker::Heavy;
  8         23  
  8         245  
8 8     8   3348 use Module::Faker::Package;
  8         30  
  8         359  
9 8     8   4194 use Module::Faker::Module;
  8         26  
  8         306  
10              
11 8     8   3996 use Archive::Any::Create;
  8         89092  
  8         79  
12 8     8   3737 use CPAN::DistnameInfo;
  8         7618  
  8         91  
13 8     8   3849 use CPAN::Meta 2.130880; # github issue #9
  8         209212  
  8         68  
14 8     8   287 use CPAN::Meta::Converter;
  8         17  
  8         32  
15 8     8   4010 use CPAN::Meta::Merge;
  8         16303  
  8         66  
16 8     8   249 use CPAN::Meta::Requirements;
  8         19  
  8         50  
17 8     8   164 use Data::OptList ();
  8         18  
  8         159  
18 8     8   4275 use Encode qw( encode_utf8 );
  8         68343  
  8         525  
19 8     8   4862 use File::Temp ();
  8         134395  
  8         217  
20 8     8   106 use File::Path ();
  8         19  
  8         196  
21 8     8   46 use Parse::CPAN::Meta 1.4401;
  8         160  
  8         332  
22 8     8   3385 use Path::Class;
  8         147865  
  8         478  
23 8     8   5055 use Storable qw(dclone);
  8         24935  
  8         6815  
24              
25             #pod =head1 SYNOPSIS
26             #pod
27             #pod Building one dist at a time makes plenty of sense, so Module::Faker::Dist makes
28             #pod it easy. Building dists from definitions in files is also useful for doing
29             #pod things in bulk (see L<CPAN::Faker>), so there are a bunch of ways to build
30             #pod dists from a definition in a file.
31             #pod
32             #pod # Build from a META.yml or META.json file, or the delightful
33             #pod # AUTHOR_Foo-Bar-1.234.tar.gz.dist file, which can be zero bytes and gets
34             #pod # all the relevant data from the filename.
35             #pod my $dist = Module::Faker::Dist->from_file($filename);
36             #pod
37             #pod META files can contain a key called X_Module_Faker that contains attributes to
38             #pod use in constructing the dist. C<dist> files can contain anything you want, but
39             #pod the contents won't do a thing.
40             #pod
41             #pod You can use the C<new> method on Module::Faker::Dist, of course, but it's a bit
42             #pod of a pain. You might, instead, want to use C<from_struct>, which is very close
43             #pod to C<new>, but with more sugar.
44             #pod
45             #pod =cut
46              
47             #pod =attr name
48             #pod
49             #pod This is the name of the dist. It will usually look like C<Foo-Bar>.
50             #pod
51             #pod =attr version
52             #pod
53             #pod This is the version of the dist, usually some kind of versiony string like
54             #pod C<1.234> or maybe C<1.2.3>.
55             #pod
56             #pod =attr abstract
57             #pod
58             #pod The abstract! This is a short, pithy description of the distribution, usually
59             #pod less than a sentence.
60             #pod
61             #pod =attr release_status
62             #pod
63             #pod This is the dist's release status. (See L<CPAN::Meta::Spec>.) It defaults to
64             #pod C<stable> but C<unstable> and C<testing> are valid values.
65             #pod
66             #pod =cut
67              
68             my $DEFAULT_VERSION;
69              
70             # required by CPAN::Meta::Spec
71             has name => (is => 'ro', isa => 'Str', required => $DEFAULT_VERSION);
72             has version => (is => 'ro', isa => 'Maybe[Str]', default => '0.01');
73             has abstract => (is => 'ro', isa => 'Str', default => 'a great new dist');
74             has release_status => (is => 'ro', isa => 'Str', default => 'stable');
75              
76             #pod =attr cpan_author
77             #pod
78             #pod This is the PAUSE id of the author, like C<RJBS>.
79             #pod
80             #pod =attr archive_ext
81             #pod
82             #pod This is the extension of the archive to build, when you build an archive. This
83             #pod defaults to C<tar.gz>. C<zip> should work, but right now it doesn't. So
84             #pod probably stuck to C<tar.gz>. It would be cool to support more attributes in
85             #pod the future.
86             #pod
87             #pod =attr append
88             #pod
89             #pod This is an arrayref of hashrefs, each of which looks like:
90             #pod
91             #pod { file => $filename, content => $character_string }
92             #pod
93             #pod The content will be UTF-8 encoded and put into a file with the given name.
94             #pod
95             #pod This feature is a bit weird. Maybe it will go away eventually.
96             #pod
97             #pod =attr mtime
98             #pod
99             #pod If given, this is the epoch seconds to which to set the mtime of the generated
100             #pod file. This is useful in rare occasions.
101             #pod
102             #pod =cut
103              
104             # Module::Faker options
105             has cpan_author => (is => 'ro', isa => 'Maybe[Str]', default => 'LOCAL');
106             has archive_ext => (is => 'ro', isa => 'Str', default => 'tar.gz');
107             has append => (is => 'ro', isa => 'ArrayRef[HashRef]', default => sub {[]});
108             has mtime => (is => 'ro', isa => 'Int', predicate => 'has_mtime');
109              
110             #pod =attr x_authority
111             #pod
112             #pod This is the C<X_Authority> header that gets put into the META files.
113             #pod
114             #pod =cut
115              
116             has x_authority => (is => 'ro', isa => 'Str');
117              
118             #pod =attr license
119             #pod
120             #pod This is the meta spec license string for the distribution. It defaults to
121             #pod C<perl_5>.
122             #pod
123             #pod =cut
124              
125             has license => (
126             is => 'ro',
127             isa => 'ArrayRef[Str]',
128             default => sub { [ 'perl_5' ] },
129             );
130              
131             #pod =attr authors
132             #pod
133             #pod This is an array of strings who are used as the authors in the dist metadata.
134             #pod The default is:
135             #pod
136             #pod [ "AUTHOR <AUTHOR@cpan.local>" ]
137             #pod
138             #pod ...where C<AUTHOR> is the C<cpan_author> of the dist.
139             #pod
140             #pod =cut
141              
142             has authors => (
143             isa => 'ArrayRef[Str]',
144             lazy => 1,
145             traits => [ 'Array' ],
146             handles => { authors => 'elements' },
147             default => sub {
148             my ($self) = @_;
149             return [ sprintf '%s <%s@cpan.local>', ($self->cpan_author) x 2 ];
150             },
151             );
152              
153             #pod =attr include_provides_in_meta
154             #pod
155             #pod This is a bool. If true, the produced META files will include a C<provides>
156             #pod key based on the packages in the dist. It defaults to false, to match the
157             #pod most common behavior of dists in the wild.
158             #pod
159             #pod =cut
160              
161             has include_provides_in_meta => (
162             is => 'ro',
163             isa => 'Bool',
164             default => 0,
165             );
166              
167             #pod =attr provides
168             #pod
169             #pod This is a hashref that gets used as the C<provides> in the metadata.
170             #pod
171             #pod If no provided, it is built from the C<packages> provided in construction.
172             #pod
173             #pod If no packages were provided, for a dist named Foo-Bar, it defaults to:
174             #pod
175             #pod { 'Foo::Bar' => { version => $DIST_VERSION, file => "lib/Foo/Bar.pm" } }
176             #pod
177             #pod =cut
178              
179             has provides => (
180             is => 'ro',
181             isa => 'HashRef',
182             lazy_build => 1,
183             );
184              
185             sub _build_provides {
186 14     14   37 my ($self) = @_;
187              
188 14 50       467 if ($self->has_packages) {
189             return {
190 0 0       0 map {; $_->name => {
  0         0  
191             file => $_->in_file,
192             (defined $_->version ? (version => $_->version) : ()),
193             } } $self->packages
194             }
195             }
196              
197 14         360 my $pkg = __dist_to_pkg($self->name);
198             return {
199 14         371 $pkg => {
200             version => $self->version,
201             file => __pkg_to_file($pkg),
202             }
203             };
204             };
205              
206 20 100   20   701 sub __dor { defined $_[0] ? $_[0] : $_[1] }
207              
208             sub append_for {
209 48     48 0 150 my ($self, $filename) = @_;
210             return [
211             # YAML and JSON should both be in utf8 (if not plain ascii)
212 14         68 map { encode_utf8($_->{content}) }
213 30         80 grep { $filename eq $_->{file} }
214 48         98 @{ $self->append }
  48         1305  
215             ];
216             }
217              
218             #pod =attr archive_basename
219             #pod
220             #pod If written to disk, the archive will be written to...
221             #pod
222             #pod $dist->archive_basename . '.' . $dist->archive_ext
223             #pod
224             #pod The default is:
225             #pod
226             #pod $dist->name . '.' . ($dist->version // 'undef')
227             #pod
228             #pod =cut
229              
230             has archive_basename => (
231             is => 'ro',
232             isa => 'Str',
233             lazy => 1,
234             default => sub {
235             my ($self) = @_;
236             return sprintf '%s-%s', $self->name, __dor($self->version, 'undef');
237             },
238             );
239              
240             #pod =attr omitted_files
241             #pod
242             #pod If given, this is an arrayref of filenames that shouldn't be automatically
243             #pod generated and included.
244             #pod
245             #pod =cut
246              
247             has omitted_files => (
248             isa => 'ArrayRef[Str]',
249             traits => [ 'Array' ],
250             handles => { omitted_files => 'elements' },
251             lazy => 1,
252             default => sub { [] },
253             );
254              
255 14     14   31 sub __dist_to_pkg { my $str = shift; $str =~ s/-/::/g; return $str; }
  14         71  
  14         40  
256 14     14   30 sub __pkg_to_file { my $str = shift; $str =~ s{::}{/}g; return "lib/$str.pm"; }
  14         60  
  14         409  
257              
258             # This is stupid, but copes with MakeMaker wanting to have a module name as its
259             # NAME parameter. Ugh! -- rjbs, 2008-03-13
260             sub _pkgy_name {
261 19     19   2158 my $name = shift->name;
262 19         112 $name =~ s/-/::/g;
263              
264 19         199 return $name;
265             }
266              
267             #pod =attr packages
268             #pod
269             #pod This is an array of L<Module::Faker::Package> objects. It's built by
270             #pod C<provides> if needed, but you might want to look at using the
271             #pod C<L</from_struct>> method to set it up.
272             #pod
273             #pod =cut
274              
275             has packages => (
276             isa => 'Module::Faker::Type::Packages',
277             lazy => 1,
278             builder => '_build_packages',
279             traits => [ 'Array' ],
280             handles => { packages => 'elements' },
281             predicate => 'has_packages',
282             );
283              
284             sub _build_packages {
285 19     19   51 my ($self) = @_;
286              
287 19         505 my $href = $self->provides;
288              
289             # do this dance so we don't autovivify X_Module_Faker in provides
290 19         91 my %package_order = map {;
291 36 100       205 $_ => (exists $href->{$_}{X_Module_Faker} ? $href->{$_}{X_Module_Faker}{order} : 0 )
292             } keys %$href;
293              
294 19         49 my @pkg_names = do {
295 8     8   72 no warnings 'uninitialized';
  8         27  
  8         15049  
296 19         98 sort { $package_order{$a} <=> $package_order{$b} } keys %package_order;
  24         85  
297             };
298              
299 19         55 my @packages;
300 19         56 for my $name (@pkg_names) {
301             push @packages, Module::Faker::Package->new({
302             name => $name,
303             version => $href->{$name}{version},
304             in_file => $href->{$name}{file},
305 36         25874 });
306             }
307              
308 19         28677 return \@packages;
309             }
310              
311             #pod =method modules
312             #pod
313             #pod This produces and returns a list of L<Module::Faker::Module> objects,
314             #pod representing modules. Modules, if you're not as steeped in CPAN toolchain
315             #pod nonsense, are the C<.pm> files in which packages are defined.
316             #pod
317             #pod These are produced by combining the packages from C<L</packages>> into files
318             #pod based on their C<in_file> attributes.
319             #pod
320             #pod =cut
321              
322             sub modules {
323 38     38 1 87 my ($self) = @_;
324              
325 38         63 my %module;
326 38         1331 for my $pkg ($self->packages) {
327 72         2000 my $filename = $pkg->in_file;
328              
329 72   100     116 push @{ $module{ $filename } ||= [] }, $pkg;
  72         370  
330             }
331              
332             my @modules = map {
333 38         200 Module::Faker::Module->new({
334 44         7876 packages => $module{$_},
335             filename => $_,
336             append => $self->append_for($_)
337             });
338             } keys %module;
339              
340 38         47642 return @modules;
341             }
342              
343             sub _mk_container_path {
344 61     61   131 my ($self, $filename) = @_;
345              
346 61         449 my (@parts) = File::Spec->splitdir($filename);
347 61         136 my $leaf_filename = pop @parts;
348 61         5862 File::Path::mkpath(File::Spec->catdir(@parts));
349             }
350              
351             #pod =method C<make_dist_dir>
352             #pod
353             #pod my $directory_name = $dist->make_dist_dir(\%arg);
354             #pod
355             #pod This returns the name of a directory into which the dist's contents have been
356             #pod written. If a C<dir> argument is provided, the dist will be written to a
357             #pod directory beneath that dir. Otherwise, it will be written below a temporary
358             #pod directory.
359             #pod
360             #pod =cut
361              
362             sub make_dist_dir {
363 8     8 1 4379 my ($self, $arg) = @_;
364 8   100     35 $arg ||= {};
365              
366 8   66     40 my $dir = $arg->{dir} || File::Temp::tempdir;
367 8         1348 my $dist_dir = File::Spec->catdir($dir, $self->archive_basename);
368              
369 8         42 for my $file ($self->files) {
370 50         1769 my $fqfn = File::Spec->catfile($dist_dir, $file->filename);
371 50         266 $self->_mk_container_path($fqfn);
372              
373 50 50       2983 open my $fh, '>', $fqfn or die "couldn't open $fqfn for writing: $!";
374 50         337 print $fh $file->as_string;
375 50 50       2041 close $fh or die "error when closing $fqfn: $!";
376             }
377              
378 8         61 return $dist_dir;
379             }
380              
381             sub _author_dir_infix {
382 0     0   0 my ($self) = @_;
383              
384 0 0       0 Carp::croak "can't put archive in author dir with no author defined"
385             unless my $pauseid = $self->cpan_author;
386              
387             # Sorta like pow- pow- power-wheels! -- rjbs, 2008-03-14
388 0         0 my ($pa, $p) = $pauseid =~ /^((.).)/;
389 0         0 return ($p, $pa, $pauseid);
390             }
391              
392             sub archive_filename {
393 11     11 0 1455 my ($self, $arg) = @_;
394              
395 11         314 my $base = $self->archive_basename;
396 11         304 my $ext = $self->archive_ext;
397              
398             return File::Spec->catfile(
399 11 50       213 ($arg->{author_prefix} ? $self->_author_dir_infix : ()),
400             "$base.$ext",
401             );
402             }
403              
404             #pod =method make_archive
405             #pod
406             #pod my $archive_filename = $dist->make_archive(\%arg);
407             #pod
408             #pod This writes the dist archive file, like a tarball or zip file. If a C<dir>
409             #pod argument is given, it will be written in that directory. Otherwise, it will be
410             #pod written to a temporary directory. If the C<author_prefix> argument is given
411             #pod and true, it will be written under a hashed author dir, like:
412             #pod
413             #pod U/US/USERID/Foo-Bar-1.23.tar.gz
414             #pod
415             #pod =cut
416              
417             sub make_archive {
418 11     11 1 726 my ($self, $arg) = @_;
419 11   50     39 $arg ||= {};
420              
421 11   33     34 my $dir = $arg->{dir} || File::Temp::tempdir;
422              
423 11         71 my $archive = Archive::Any::Create->new;
424 11         354 my $container = $self->archive_basename;
425              
426 11         64 $archive->container($container);
427              
428 11         102 for my $file ($self->files) {
429 69         2028 $archive->add_file($file->filename, $file->as_string);
430             }
431              
432             my $archive_filename = File::Spec->catfile(
433             $dir,
434             $self->archive_filename({ author_prefix => $arg->{author_prefix} })
435 11         92 );
436              
437 11         58 $self->_mk_container_path($archive_filename);
438 11         76 $archive->write_file($archive_filename);
439 11 100       182190 utime time, $self->mtime, $archive_filename if $self->has_mtime;
440 11         111 return $archive_filename;
441             }
442              
443             sub files {
444 19     19 0 52 my ($self) = @_;
445 19         62 my @files = ($self->modules, $self->_extras, $self->_manifest_file);
446 19         43 for my $file (@{$self->append}) {
  19         532  
447 10 100       2287 next if grep { $_->filename eq $file->{file} } @files;
  62         1512  
448             push(@files,
449             $self->_file_class->new(
450             filename => $file->{file},
451             content => '',
452 4         16 append => $self->append_for($file->{file}),
453             ) );
454             }
455 19         2351 return @files;
456             }
457              
458 97     97   487 sub _file_class { 'Module::Faker::File' }
459              
460             around BUILDARGS => sub {
461             my ($orig, $self, @rest) = @_;
462             my $arg = $self->$orig(@rest);
463              
464             confess "can't supply both requires and prereqs"
465             if $arg->{prereqs} && $arg->{requires};
466              
467             if ($arg->{requires}) {
468             $arg->{prereqs} = {
469             runtime => { requires => delete $arg->{requires} }
470             };
471             }
472              
473             return $arg;
474             };
475              
476             sub BUILD {
477 22     22 0 56251 my ($self) = @_;
478 22         697 my $provides = $self->provides;
479              
480 22   33     202 $provides->{$_}{file} //= __pkg_to_file($_) for keys %$provides;
481             }
482              
483             has prereqs => (
484             is => 'ro',
485             isa => 'HashRef',
486             default => sub { {} },
487             );
488              
489             has _manifest_file => (
490             is => 'ro',
491             isa => 'Module::Faker::File',
492             lazy => 1,
493             default => sub {
494             my ($self) = @_;
495             my @files = ($self->modules, $self->_extras);
496              
497             return $self->_file_class->new({
498             filename => 'MANIFEST',
499             content => join("\n",
500             'MANIFEST',
501             map { $_->filename } @files
502             ),
503             });
504             },
505             );
506              
507             #pod =attr more_metadata
508             #pod
509             #pod This can be given as a hashref of data to merge into the CPAN::Meta files.
510             #pod
511             #pod =cut
512              
513             has more_metadata => (
514             is => 'ro',
515             isa => 'HashRef',
516             predicate => 'has_more_metadata',
517             );
518              
519             #pod =attr meta_munger
520             #pod
521             #pod If given, this is a coderef that's called just before the CPAN::Meta data for
522             #pod the dist is written to disk, an can be used to change things, especially into
523             #pod invalid data. It is expected to return the new content to serialize.
524             #pod
525             #pod It's called like this:
526             #pod
527             #pod $coderef->($struct, { format => $format, version => $version });
528             #pod
529             #pod ...where C<$struct> is the result of C<< $cpan_meta->as_struct >>.
530             #pod C<$version> is the version number of the target metafile. Normally, both
531             #pod version 1.4 and 2 are requested. C<$format> is either C<yaml> or C<json>.
532             #pod
533             #pod If the munger returns a string instead of a structure, it will be used as the
534             #pod content of the file being written. This lets you put all kinds of nonsense in
535             #pod those meta files. Have fun, go nuts!
536             #pod
537             #pod =cut
538              
539             has meta_munger => (
540             isa => 'CodeRef',
541             predicate => 'has_meta_munger',
542             traits => [ 'Code' ],
543             handles => { munge_meta => 'execute' },
544             );
545              
546             has _cpan_meta => (
547             is => 'ro',
548             isa => 'CPAN::Meta',
549             lazy_build => 1,
550             );
551              
552             sub _build__cpan_meta {
553 19     19   109 my ($self) = @_;
554 19         719 my $meta = {
555             'meta-spec' => { version => '2' },
556             dynamic_config => 0,
557             author => [ $self->authors ], # plural attribute that derefs
558             };
559             # required fields
560 19         70 for my $key ( qw/abstract license name release_status version/ ) {
561 95         2492 $meta->{$key} = $self->$key;
562             }
563             # optional fields
564 19         59 for my $key ( qw/prereqs x_authority/ ) {
565 38         1183 my $value = $self->$key;
566 38 100       201 $meta->{$key} = $value if $value;
567             }
568              
569 19 100 66     533 if ($self->provides && $self->include_provides_in_meta) {
570 1         28 $meta->{provides} = $self->provides;
571             }
572              
573 19         212 my $cpanmeta = CPAN::Meta->new( $meta, {lazy_validation => 1} );
574 19 50       24928 return $cpanmeta unless $self->has_more_metadata;
575              
576 0         0 return CPAN::Meta->new(
577             CPAN::Meta::Merge->new(default_version => 2)->merge(
578             $cpanmeta,
579             $self->more_metadata,
580             ),
581             { lazy_validation => 1 }
582             );
583             }
584              
585             has _extras => (
586             isa => 'ArrayRef[Module::Faker::File]',
587             lazy => 1,
588             traits => [ 'Array' ],
589             handles => { _extras => 'elements' },
590             default => sub {
591             my ($self) = @_;
592             my @files;
593              
594             for my $filename (qw(Makefile.PL t/00-nop.t)) {
595             next if grep { $_ eq $filename } $self->omitted_files;
596             push @files, $self->_file_class->new({
597             filename => $filename,
598             content => Module::Faker::Heavy->_render(
599             $filename,
600             { dist => $self },
601             ),
602             });
603             }
604              
605             unless ( grep { $_ eq 'META.json' } $self->omitted_files ) {
606             push @files, $self->_file_class->new({
607             filename => 'META.json',
608             content => $self->_meta_file_content(json => 2),
609             });
610             }
611              
612             unless ( grep { $_ eq 'META.yml' } $self->omitted_files ) {
613             push @files, $self->_file_class->new({
614             filename => 'META.yml',
615             content => $self->_meta_file_content(yaml => 1.4),
616             });
617             }
618              
619             return \@files;
620             },
621             );
622              
623             # This code is based on the code in CPAN::Meta v2.150010
624             # -- rjbs, 2019-04-28
625             sub _meta_file_content {
626 36     36   93 my ($self, $format, $version) = @_;
627              
628 36         925 my $meta = $self->_cpan_meta;
629              
630 36         67 my $struct;
631 36 100       138 if ($meta->meta_spec_version ne $version) {
632 17         738 $struct = CPAN::Meta::Converter->new($meta->as_struct)
633             ->convert(version => $version);
634             } else {
635 19         769 $struct = $meta->as_struct;
636             }
637              
638 36 50       25757 if ($self->has_meta_munger) {
639             # Is that dclone() paranoia? Maybe. -- rjbs, 2019-04-28
640 0         0 $struct = $self->munge_meta(
641             dclone($struct),
642             {
643             format => $format,
644             version => $version
645             },
646             );
647              
648 0 0       0 return $struct unless ref $struct;
649             }
650              
651 36         84 my ($data, $backend);
652 36 100       139 if ($format eq 'json') {
    50          
653 19         112 $backend = Parse::CPAN::Meta->json_backend();
654 19         58222 local $struct->{x_serialization_backend} = sprintf '%s version %s',
655             $backend, $backend->VERSION;
656 19         134 $data = $backend->new->pretty->canonical->encode($struct);
657             } elsif ($format eq 'yaml') {
658 17         94 $backend = Parse::CPAN::Meta->yaml_backend();
659 17         7020 local $struct->{x_serialization_backend} = sprintf '%s version %s',
660             $backend, $backend->VERSION;
661 8     8   75 $data = eval { no strict 'refs'; &{"$backend\::Dump"}($struct) };
  8         19  
  8         6149  
  17         57  
  17         36  
  17         127  
662 17 50       11973 if ( $@ ) {
663 0 0       0 croak($backend->can('errstr') ? $backend->errstr : $@);
664             }
665             } else {
666 0         0 confess "unknown meta format: $format"
667             }
668              
669 36         17130 return $data;
670             }
671              
672             #pod =method from_file
673             #pod
674             #pod my $dist = Module::Faker::Dist->from_file($filename);
675             #pod
676             #pod Given a filename with dist configuration, this builds the dist described by the
677             #pod file.
678             #pod
679             #pod Given a file ending in C<yaml> or C<yml> or C<json>, it's treated as a
680             #pod CPAN::Meta file and interpreted as such. The key C<X_Module_Faker> can be
681             #pod present to provide attributes that don't match data found in a meta file.
682             #pod
683             #pod Given a file ending in C<dist>, all the configuration comes from the filename,
684             #pod which should look like this:
685             #pod
686             #pod AUTHOR_Dist-Name-1.234.tar.gz.dist
687             #pod
688             #pod =cut
689              
690             # TODO: make this a registry -- rjbs, 2008-03-12
691             my %HANDLER_FOR = (
692             yaml => '_from_meta_file',
693             yml => '_from_meta_file',
694             json => '_from_meta_file',
695             dist => '_from_distnameinfo'
696             );
697              
698             sub from_file {
699 21     21 1 122501 my ($self, $filename) = @_;
700              
701 21         147 my ($ext) = $filename =~ /.*\.(.+?)\z/;
702              
703             Carp::croak "don't know how to handle file $filename"
704 21 50 33     177 unless $ext and my $method = $HANDLER_FOR{$ext};
705              
706 21         101 $self->$method($filename);
707             }
708              
709             sub _from_distnameinfo {
710 2     2   6 my ($self, $filename) = @_;
711 2         12 $filename = file($filename)->basename;
712 2         360 $filename =~ s/\.dist$//;
713              
714 2         9 my ($author, $path) = split /_/, $filename, 2;
715              
716 2         16 my $dni = CPAN::DistnameInfo->new($path);
717              
718 2         160 return $self->new({
719             name => $dni->dist,
720             version => $dni->version,
721             abstract => sprintf('the %s dist', $dni->dist),
722             archive_ext => $dni->extension,
723             cpan_author => $author,
724             });
725             }
726              
727             sub _from_meta_file {
728 19     19   56 my ($self, $filename) = @_;
729              
730 19         153 my $data = Parse::CPAN::Meta->load_file($filename);
731 19   100     103147 my $extra = (delete $data->{X_Module_Faker}) || {};
732 19         306 my $dist = $self->new({ %$data, %$extra });
733             }
734              
735             sub _flat_prereqs {
736 19     19   3114 my ($self) = @_;
737 19         699 my $prereqs = $self->_cpan_meta->effective_prereqs;
738 19         3462 my $req = CPAN::Meta::Requirements->new;
739 19         330 for my $phase ( qw/runtime build test/ ) {
740 57         2939 $req->add_requirements( $prereqs->requirements_for( $phase, 'requires' ) );
741             }
742 19         1201 return %{ $req->as_string_hash };
  19         76  
743             }
744              
745             #pod =method from_struct
746             #pod
747             #pod my $dist = Module::Faker::Dist->from_struct(\%arg);
748             #pod
749             #pod This is sugar over C<new>, working like this:
750             #pod
751             #pod =for :list
752             #pod * packages version defaults to the dist version unless specified
753             #pod * packages for dist Foo-Bar defaults to Foo::Bar unless specified
754             #pod * if specified, packages is an L<optlist|Data::OptList>
755             #pod
756             #pod =cut
757              
758             sub from_struct {
759 0     0 1   my ($self, $arg) = @_;
760              
761 0 0         my $version = exists $arg->{version} ? $arg->{version} : $DEFAULT_VERSION;
762              
763             my $specs = Data::OptList::mkopt(
764             ! exists $arg->{packages} ? [ __dist_to_pkg($arg->{name}) ]
765             : ref $arg->{packages} ? $arg->{packages}
766 0 0         : defined $arg->{packages} ? [ $arg->{packages} ]
    0          
    0          
767             : ()
768             );
769              
770 0           my @packages;
771 0           for my $spec (@$specs) {
772 0 0         my %spec = $spec->[1] ? %{ $spec->[1] } : ();
  0            
773              
774             push @packages, Module::Faker::Package->new({
775             name => $spec->[0],
776             in_file => __pkg_to_file($spec->[0]), # to be overridden below if needed
777             %spec,
778 0 0         version => (exists $spec{version} ? $spec{version} : $version),
779             });
780             }
781              
782 0           return $self->new({
783             %$arg,
784             version => $version,
785             packages => \@packages,
786             });
787             }
788              
789             1;
790              
791             # vim: ts=2 sts=2 sw=2 et:
792              
793             __END__
794              
795             =pod
796              
797             =encoding UTF-8
798              
799             =head1 NAME
800              
801             Module::Faker::Dist - a fake CPAN distribution
802              
803             =head1 VERSION
804              
805             version 0.022
806              
807             =head1 SYNOPSIS
808              
809             Building one dist at a time makes plenty of sense, so Module::Faker::Dist makes
810             it easy. Building dists from definitions in files is also useful for doing
811             things in bulk (see L<CPAN::Faker>), so there are a bunch of ways to build
812             dists from a definition in a file.
813              
814             # Build from a META.yml or META.json file, or the delightful
815             # AUTHOR_Foo-Bar-1.234.tar.gz.dist file, which can be zero bytes and gets
816             # all the relevant data from the filename.
817             my $dist = Module::Faker::Dist->from_file($filename);
818              
819             META files can contain a key called X_Module_Faker that contains attributes to
820             use in constructing the dist. C<dist> files can contain anything you want, but
821             the contents won't do a thing.
822              
823             You can use the C<new> method on Module::Faker::Dist, of course, but it's a bit
824             of a pain. You might, instead, want to use C<from_struct>, which is very close
825             to C<new>, but with more sugar.
826              
827             =head1 ATTRIBUTES
828              
829             =head2 name
830              
831             This is the name of the dist. It will usually look like C<Foo-Bar>.
832              
833             =head2 version
834              
835             This is the version of the dist, usually some kind of versiony string like
836             C<1.234> or maybe C<1.2.3>.
837              
838             =head2 abstract
839              
840             The abstract! This is a short, pithy description of the distribution, usually
841             less than a sentence.
842              
843             =head2 release_status
844              
845             This is the dist's release status. (See L<CPAN::Meta::Spec>.) It defaults to
846             C<stable> but C<unstable> and C<testing> are valid values.
847              
848             =head2 cpan_author
849              
850             This is the PAUSE id of the author, like C<RJBS>.
851              
852             =head2 archive_ext
853              
854             This is the extension of the archive to build, when you build an archive. This
855             defaults to C<tar.gz>. C<zip> should work, but right now it doesn't. So
856             probably stuck to C<tar.gz>. It would be cool to support more attributes in
857             the future.
858              
859             =head2 append
860              
861             This is an arrayref of hashrefs, each of which looks like:
862              
863             { file => $filename, content => $character_string }
864              
865             The content will be UTF-8 encoded and put into a file with the given name.
866              
867             This feature is a bit weird. Maybe it will go away eventually.
868              
869             =head2 mtime
870              
871             If given, this is the epoch seconds to which to set the mtime of the generated
872             file. This is useful in rare occasions.
873              
874             =head2 x_authority
875              
876             This is the C<X_Authority> header that gets put into the META files.
877              
878             =head2 license
879              
880             This is the meta spec license string for the distribution. It defaults to
881             C<perl_5>.
882              
883             =head2 authors
884              
885             This is an array of strings who are used as the authors in the dist metadata.
886             The default is:
887              
888             [ "AUTHOR <AUTHOR@cpan.local>" ]
889              
890             ...where C<AUTHOR> is the C<cpan_author> of the dist.
891              
892             =head2 include_provides_in_meta
893              
894             This is a bool. If true, the produced META files will include a C<provides>
895             key based on the packages in the dist. It defaults to false, to match the
896             most common behavior of dists in the wild.
897              
898             =head2 provides
899              
900             This is a hashref that gets used as the C<provides> in the metadata.
901              
902             If no provided, it is built from the C<packages> provided in construction.
903              
904             If no packages were provided, for a dist named Foo-Bar, it defaults to:
905              
906             { 'Foo::Bar' => { version => $DIST_VERSION, file => "lib/Foo/Bar.pm" } }
907              
908             =head2 archive_basename
909              
910             If written to disk, the archive will be written to...
911              
912             $dist->archive_basename . '.' . $dist->archive_ext
913              
914             The default is:
915              
916             $dist->name . '.' . ($dist->version // 'undef')
917              
918             =head2 omitted_files
919              
920             If given, this is an arrayref of filenames that shouldn't be automatically
921             generated and included.
922              
923             =head2 packages
924              
925             This is an array of L<Module::Faker::Package> objects. It's built by
926             C<provides> if needed, but you might want to look at using the
927             C<L</from_struct>> method to set it up.
928              
929             =head2 more_metadata
930              
931             This can be given as a hashref of data to merge into the CPAN::Meta files.
932              
933             =head2 meta_munger
934              
935             If given, this is a coderef that's called just before the CPAN::Meta data for
936             the dist is written to disk, an can be used to change things, especially into
937             invalid data. It is expected to return the new content to serialize.
938              
939             It's called like this:
940              
941             $coderef->($struct, { format => $format, version => $version });
942              
943             ...where C<$struct> is the result of C<< $cpan_meta->as_struct >>.
944             C<$version> is the version number of the target metafile. Normally, both
945             version 1.4 and 2 are requested. C<$format> is either C<yaml> or C<json>.
946              
947             If the munger returns a string instead of a structure, it will be used as the
948             content of the file being written. This lets you put all kinds of nonsense in
949             those meta files. Have fun, go nuts!
950              
951             =head1 METHODS
952              
953             =head2 modules
954              
955             This produces and returns a list of L<Module::Faker::Module> objects,
956             representing modules. Modules, if you're not as steeped in CPAN toolchain
957             nonsense, are the C<.pm> files in which packages are defined.
958              
959             These are produced by combining the packages from C<L</packages>> into files
960             based on their C<in_file> attributes.
961              
962             =head2 C<make_dist_dir>
963              
964             my $directory_name = $dist->make_dist_dir(\%arg);
965              
966             This returns the name of a directory into which the dist's contents have been
967             written. If a C<dir> argument is provided, the dist will be written to a
968             directory beneath that dir. Otherwise, it will be written below a temporary
969             directory.
970              
971             =head2 make_archive
972              
973             my $archive_filename = $dist->make_archive(\%arg);
974              
975             This writes the dist archive file, like a tarball or zip file. If a C<dir>
976             argument is given, it will be written in that directory. Otherwise, it will be
977             written to a temporary directory. If the C<author_prefix> argument is given
978             and true, it will be written under a hashed author dir, like:
979              
980             U/US/USERID/Foo-Bar-1.23.tar.gz
981              
982             =head2 from_file
983              
984             my $dist = Module::Faker::Dist->from_file($filename);
985              
986             Given a filename with dist configuration, this builds the dist described by the
987             file.
988              
989             Given a file ending in C<yaml> or C<yml> or C<json>, it's treated as a
990             CPAN::Meta file and interpreted as such. The key C<X_Module_Faker> can be
991             present to provide attributes that don't match data found in a meta file.
992              
993             Given a file ending in C<dist>, all the configuration comes from the filename,
994             which should look like this:
995              
996             AUTHOR_Dist-Name-1.234.tar.gz.dist
997              
998             =head2 from_struct
999              
1000             my $dist = Module::Faker::Dist->from_struct(\%arg);
1001              
1002             This is sugar over C<new>, working like this:
1003              
1004             =over 4
1005              
1006             =item *
1007              
1008             packages version defaults to the dist version unless specified
1009              
1010             =item *
1011              
1012             packages for dist Foo-Bar defaults to Foo::Bar unless specified
1013              
1014             =item *
1015              
1016             if specified, packages is an L<optlist|Data::OptList>
1017              
1018             =back
1019              
1020             =head1 AUTHOR
1021              
1022             Ricardo Signes <rjbs@cpan.org>
1023              
1024             =head1 COPYRIGHT AND LICENSE
1025              
1026             This software is copyright (c) 2008 by Ricardo Signes.
1027              
1028             This is free software; you can redistribute it and/or modify it under
1029             the same terms as the Perl 5 programming language system itself.
1030              
1031             =cut