File Coverage

blib/lib/Boxer/World/Flat.pm
Criterion Covered Total %
statement 67 67 100.0
branch 2 2 100.0
condition n/a
subroutine 13 13 100.0
pod 0 1 0.0
total 82 83 98.8


line stmt bran cond sub pod time code
1             package Boxer::World::Flat;
2              
3             =encoding UTF-8
4              
5             =head1 NAME
6              
7             Boxer::World::Flat - software for single use case
8              
9             =cut
10              
11 6     6   3980 use v5.20;
  6         23  
12 6     6   37 use utf8;
  6         13  
  6         38  
13 6     6   189 use Role::Commons -all;
  6         11  
  6         42  
14 6     6   11255 use feature 'signatures';
  6         13  
  6         628  
15 6     6   39 use namespace::autoclean 0.16;
  6         126  
  6         42  
16 6     6   1097 use autodie;
  6         14516  
  6         35  
17              
18 6     6   34484 use Moo;
  6         2764  
  6         29  
19 6     6   4441 use MooX::StrictConstructor;
  6         2625  
  6         43  
20             extends qw(Boxer::World);
21              
22 6     6   29539 use Types::Standard qw( Maybe Bool Tuple );
  6         63940  
  6         434  
23 6     6   6695 use Types::TypeTiny qw( StringLike ArrayLike );
  6         11  
  6         41  
24              
25 6     6   1810 use strictures 2;
  6         51  
  6         269  
26 6     6   1326 no warnings "experimental::signatures";
  6         16  
  6         4223  
27              
28             =head1 VERSION
29              
30             Version v1.4.1
31              
32             =cut
33              
34             our $VERSION = "v1.4.1";
35              
36             =head1 DESCRIPTION
37              
38             Outside the box is a world of software.
39              
40             B<Boxer::World::Flat> is a class describing a collection of software
41             available for installation into (or as) an operating system.
42              
43             =head1 SEE ALSO
44              
45             L<Boxer>.
46              
47             =cut
48              
49             has parts => (
50             is => 'ro',
51             isa => Tuple [],
52             default => sub { [] },
53             );
54              
55             has node => (
56             is => 'ro',
57             isa => StringLike,
58             required => 1,
59             );
60              
61             has epoch => (
62             is => 'ro',
63             isa => Maybe [StringLike],
64             );
65              
66             has pkgs => (
67             is => 'ro',
68             isa => ArrayLike,
69             required => 1,
70             );
71              
72             has pkgs_auto => (
73             is => 'ro',
74             isa => ArrayLike,
75             required => 1,
76             );
77              
78             has pkgs_avoid => (
79             is => 'ro',
80             isa => ArrayLike,
81             required => 1,
82             );
83              
84             has tweaks => (
85             is => 'ro',
86             isa => ArrayLike,
87             required => 1,
88             );
89              
90             has pkgdesc => (
91             is => 'ro',
92             isa => StringLike,
93             required => 1,
94             );
95              
96             has tweakdesc => (
97             is => 'ro',
98             isa => StringLike,
99             required => 1,
100             );
101              
102             has nonfree => (
103             is => 'ro',
104             isa => Bool,
105             required => 1,
106             );
107              
108 8         22 sub as_file ( $self, $file, $oldstyle = 0 )
  8         14  
  8         14  
109 8     8 0 43 {
  8         13  
110 8         18 my $pkgs = join( ',', sort @{ $self->pkgs } );
  8         294  
111 8         23 my $pkgs_avoid = join( ',', sort @{ $self->pkgs_avoid } );
  8         44  
112 8         19 my $pkgs_auto = join( ',', sort @{ $self->pkgs_auto } );
  8         55  
113 8         17 my $tweaks = join( ";\\\n ", @{ $self->tweaks } );
  8         39  
114              
115 8         16 my $pkglist = join( ' ', sort @{ $self->pkgs } );
  8         196  
116 8         22 $pkglist .= " \\\n ";
117 8         19 $pkglist .= join( ' ', sort map { $_ . '-' } @{ $self->pkgs_avoid } );
  40         98  
  8         24  
118 8         22 my $pkgautolist = join( ' ', sort @{ $self->pkgs_auto } );
  8         92  
119              
120 8         18 my $tweaks_perl = $tweaks;
121 8         29 $tweaks_perl =~ s,chroot\s+/target\s+,,g;
122 8         29 $tweaks_perl =~ s,/target/,/,g;
123              
124             # TODO: maybe move below (or only $''{ part?) to reclass parser
125 8         67 $tweaks_perl =~ s/\\\K''(?=n)|\$\K''(?=\{)//g;
126              
127 8         126 my %vars = (
128             node => $self->node,
129             suite => $self->epoch,
130             pkgs => $pkgs,
131             pkgs_avoid => $pkgs_avoid,
132             pkgs_auto => $pkgs_auto,
133             pkgdesc => $self->pkgdesc,
134             pkglist => $pkglist,
135             tweakdesc => $self->tweakdesc,
136             tweaks => $tweaks,
137             tweaks_perl => $tweaks_perl,
138             tweaklist => $tweaks,
139             pkgautolist => $pkgautolist,
140             nonfree => $self->nonfree,
141             );
142              
143             # TODO: Drop oldstyle templating format
144             # (oldstyle preseed templates expect perl tweaks in regular tweaks string)
145 8 100       28 if ($oldstyle) {
146 4         34 my %altvars = %vars;
147 4         17 $altvars{tweaklist} = $tweaks_perl;
148 4         20 $file->create( \%altvars );
149             }
150             else {
151 4         23 $file->create( \%vars );
152             }
153              
154 8         5271 1;
155             }
156              
157             =head1 AUTHOR
158              
159             Jonas Smedegaard C<< <dr@jones.dk> >>.
160              
161             =cut
162              
163             our $AUTHORITY = 'cpan:JONASS';
164              
165             =head1 COPYRIGHT AND LICENCE
166              
167             Copyright © 2013-2016 Jonas Smedegaard
168              
169             This is free software; you can redistribute it and/or modify it under
170             the same terms as the Perl 5 programming language system itself.
171              
172             =head1 DISCLAIMER OF WARRANTIES
173              
174             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
175             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
176             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
177              
178             =cut
179              
180             1;