File Coverage

blib/lib/App/hopen/Gen.pm
Criterion Covered Total %
statement 81 95 85.2
branch 9 24 37.5
condition 1 4 25.0
subroutine 20 27 74.0
pod 9 9 100.0
total 120 159 75.4


line stmt bran cond sub pod time code
1             # App::hopen::Gen - base class for hopen generators
2             package App::hopen::Gen;
3 1     1   568 use Data::Hopen qw(:default *QUIET);
  1         2  
  1         132  
4 1     1   5 use strict; use warnings;
  1     1   2  
  1         18  
  1         4  
  1         2  
  1         51  
5 1     1   4 use Data::Hopen::Base;
  1         2  
  1         11  
6              
7             our $VERSION = '0.000015'; # TRIAL
8              
9 1     1   1205 use parent 'Data::Hopen::Visitor';
  1         2  
  1         6  
10             use Class::Tiny qw(proj_dir dest_dir), {
11             architecture => '',
12              
13             # private
14             _assets => undef, # A Data::Hopen::G::DAG of the assets
15 3         45 _assetop_by_asset => sub { +{} }, # Indexed by refaddr($asset)
16 1     1   1950 };
  1         47  
  1         11  
17              
18 1     1   1252 use App::hopen::Asset;
  1         5  
  1         40  
19 1     1   7 use App::hopen::BuildSystemGlobals;
  1         2  
  1         222  
20 1     1   7 use App::hopen::Util::String qw(eval_here);
  1         2  
  1         77  
21 1     1   7 use Data::Hopen::G::DAG;
  1         2  
  1         48  
22 1     1   7 use Data::Hopen::Util::Data qw(forward_opts);
  1         2  
  1         51  
23 1     1   757 use File::pushd qw(pushd);
  1         1752  
  1         71  
24 1     1   8 use Path::Class ();
  1         2  
  1         27  
25 1     1   5 use Scalar::Util qw(refaddr);
  1         2  
  1         1696  
26              
27             # Docs {{{1
28              
29             =head1 NAME
30              
31             App::hopen::Gen - Base class for hopen generators
32              
33             =head1 SYNOPSIS
34              
35             The code that generates blueprints for specific build systems
36             lives under C<App::hopen::Gen>. L<App::hopen> calls modules
37             under C<App::hopen::Gen> to create the blueprints. Those modules must
38             implement the interface defined here.
39              
40             =head1 ATTRIBUTES
41              
42             =head2 architecture
43              
44             The architecture. The use of this is defined by the specific
45             generator or toolset.
46              
47             =head2 proj_dir
48              
49             (Required) A L<Path::Class::Dir> instance specifying the root directory of
50             the project.
51              
52             =head2 dest_dir
53              
54             (Required) A L<Path::Class::Dir> instance specifying where the generated output
55             (e.g., blueprint or other files) should be written.
56              
57             =head2 _assets (Internal)
58              
59             A L<Data::Hopen::G::DAG> of L<App::hopen::G::AssetOp> instances representing
60             the L<App::Hopen::Asset>s to be created when a build is run.
61              
62             =head1 FUNCTIONS
63              
64             A generator (C<App::hopen::Gen> subclass) is a Visitor plus some.
65              
66             B<Note>:
67             The generator does not have access to L<Data::Hopen::G::Link> instances.
68             That lack of access is the primary distinction between Ops and Links.
69              
70             =cut
71              
72             # }}}1
73              
74             =head2 asset
75              
76             Called by an Op (L<App::hopen::G::Op> subclass) to add an asset
77             (L<App::hopen::G::AssetOp> instance) to the build. Usage:
78              
79             $Generator->asset([-asset=>]$asset, [-from=>]$from[, [-how=>]$how]);
80              
81             If C<$how> is specified, it will be saved in the C<AssetOp> for use later.
82             Later calls with the same asset and a defined C<$how> will overwrite the
83             C<how> value in the C<AssetOp>. Specify 'UNDEF' as the C<$how> to
84             expressly undefine a C<how>.
85              
86             Returns the C<AssetOp>.
87              
88             =cut
89              
90             sub asset {
91 12     12 1 91 my ($self, %args) = getparameters('self', [qw(asset; how)], @_);
92 12     0   1406 hlog { 'Generator adding asset at',refaddr($args{asset}),$args{asset} } 3;
  0         0  
93              
94 12         523 my $existing_op = $self->_assetop_by_asset->{refaddr($args{asset})};
95              
96             # Update an existing op
97 12 50       98 if(defined $existing_op) {
98 0 0 0     0 if( ($args{how}//'') eq 'UNDEF') {
    0          
99 0         0 $existing_op->how(undef);
100             } elsif(defined $args{how}) {
101 0         0 $existing_op->how($args{how});
102             }
103 0         0 return $existing_op;
104             }
105              
106             # Need to create an op. First, load its class.
107 12         52 my $class = $self->_assetop_class;
108              
109 12         84 eval_here <<EOT;
110             require $class;
111             EOT
112 12 50       103 die "$@" if $@;
113              
114             # Create a new op
115 12         58 my $op = $class->new(name => 'Op:<<' . $args{asset}->target . '>>',
116             forward_opts(\%args, qw(asset how)));
117 12         547 $self->_assetop_by_asset->{refaddr($args{asset})} = $op;
118 12         372 $self->_assets->add($op);
119 12         3983 return $op;
120             } #asset()
121              
122             =head2 connect
123              
124             Add a dependency edge between two assets or goals. Any assets must have already
125             been added using L</asset>. Usage:
126              
127             $Generator->connect([-from=>]$from, [-to=>$to]);
128              
129             TODO add missing assets automatically?
130              
131             TODO rename the asset-graph public interface so it's more clear that it's
132             the asset graph and not the command graph.
133              
134             =cut
135              
136             sub connect {
137 12     12 1 143 my ($self, %args) = getparameters('self', [qw(from to)], @_);
138 12         1254 my %nodes;
139              
140             # Get the nodes if we were passed assets.
141 12         29 foreach my $field (qw(from to)) {
142 24 100       110 if(eval { $args{$field}->DOES('App::hopen::Asset') }) {
  24         176  
143 15         397 $nodes{$field} = $self->_assetop_by_asset->{refaddr($args{$field})};
144             } else {
145 9         26 $nodes{$field} = $args{$field};
146             }
147             }
148              
149             # TODO better error messages
150 12 50       99 croak "No From node for asset " . refaddr($args{from}) unless $nodes{from};
151 12 50       206 croak "No To node for asset " . refaddr($args{to}) unless $nodes{to};
152 12         456 $self->_assets->connect($nodes{from}, $nodes{to});
153             } #connect()
154              
155             =head2 asset_default_goal
156              
157             Read-only accessor for the default goal of the asset graph
158              
159             =cut
160              
161 4     4 1 115 sub asset_default_goal () { shift->_assets->default_goal }
162              
163             =head2 run_build
164              
165             Runs the build tool for which this generator has created blueprint files.
166             Runs the tool with the destination directory as the current dir.
167              
168             =cut
169              
170             sub run_build {
171 0 0   0 1 0 my $self = shift or croak 'Need an instance';
172 0         0 my $abs_dir = $DestDir->absolute;
173             # NOTE: You have to call this *before* pushd() or chdir(), because
174             # it may be a relative path, and absolute() converts with respect
175             # to cwd at the time of the call.
176 0         0 my $dir = pushd($abs_dir);
177 0 0       0 say "Building in ${abs_dir}..." unless $QUIET;
178 0         0 $self->_run_build();
179             } #run_build()
180              
181             =head2 BUILD
182              
183             Constructor.
184              
185             =cut
186              
187             sub BUILD {
188 6     6 1 897 my ($self, $args) = @_;
189              
190             # Enforce the required argument types
191             croak "Need a project directory (Path::Class::Dir)"
192 6 50       17 unless eval { $self->proj_dir->DOES('Path::Class::Dir') };
  6         237  
193             croak "Need a destination directory (Path::Class::Dir)"
194 6 50       99 unless eval { $self->dest_dir->DOES('Path::Class::Dir') };
  6         165  
195              
196             # Create the asset graph
197 6         68 $self->_assets(hnew DAG => 'asset graph');
198 6         7454 $self->_assets->goal('__R_asset_default_goal');
199             # Create and set default goal
200             } #BUILD()
201              
202             =head1 FUNCTIONS TO BE IMPLEMENTED BY SUBCLASSES
203              
204             =head2 _assetop_class
205              
206             (Required) Returns the name of the L<App::hopen::G::AssetOp> subclass that
207             should be used to represent assets in the C<_assets> graph.
208              
209             =cut
210              
211 0     0   0 sub _assetop_class { ... }
212              
213             =head2 default_toolset
214              
215             (Required) Returns the package stem of the default toolset for this generator.
216              
217             When a hopen file invokes C<use language "Foo">, hopen will load
218             C<< App::hopen::T::<stem>::Foo >>. C<< <stem> >> is the return
219             value of this function unless the user has specified a different toolset.
220              
221             As a sanity check, hopen will first try to load C<< App::hopen::T::<stem> >>,
222             so make sure that is a valid package.
223              
224             =cut
225              
226 0     0 1 0 sub default_toolset { ... }
227              
228             =head2 finalize
229              
230             (Optional)
231             Do whatever the generator wants to do to finish up. By default, no-op.
232             Is provided the L<Data::Hopen::G::DAG> instance as a parameter. Usage:
233              
234             $generator->finalize(-phase=>$Phase, -graph=>$Build,
235             -data=>$data)
236              
237             C<$dag> is the command graph, and C<$data> is the output from the
238             command graph.
239              
240             C<finalize> is always called with named parameters.
241              
242             =cut
243              
244       0 1   sub finalize { }
245              
246             =head2 _run_build
247              
248             (Optional)
249             Implementation of L</run_build>. The default does not die, but does warn().
250              
251             =cut
252              
253             sub _run_build {
254 0     0   0 warn "This generator is not configured to run a build tool. Sorry!";
255             } #_run_build()
256              
257             =head2 visit_goal
258              
259             Add a target corresponding to the name of the goal. Usage:
260              
261             $Generator->visit_goal($node, $node_inputs);
262              
263             This happens while the command graph is being run.
264              
265             This can be overriden by a generator that wants to handle
266             L<Data::Hopen::G::Goal> nodes differently.
267             For example, the generator may want to change the goal's C<outputs>.
268              
269             =cut
270              
271             sub visit_goal {
272 3     3 1 11962 my ($self, %args) = getparameters('self', [qw(goal node_inputs)], @_);
273              
274             # --- Add the goal to the asset graph ---
275              
276             #my $asset_goal = $self->_assets->goal($args{goal}->name);
277             my $phony_asset = App::hopen::Asset->new(
278             target => $args{goal}->name,
279 3         306 made_by => $self,
280             );
281 3         53 my $phony_node = $self->asset(-asset => $phony_asset, -how => '');
282             # \p how defined but falsy => it's a goal
283 3         37 $self->connect($phony_node, $self->asset_default_goal);
284              
285             # Pull the inputs. TODO refactor out the code in common with
286             # AhG::Cmd::input_assets().
287             my $hrSourceFiles =
288 3   50     1895 $args{node_inputs}->find(-name => 'made',
289             -set => '*', -levels => 'local') // {};
290             die 'No input files to goal ' . $args{goal}->name
291 3 50       918 unless scalar keys %$hrSourceFiles;
292              
293 3         14 my $lrSourceFiles = $hrSourceFiles->{(keys %$hrSourceFiles)[0]};
294 3     0   25 hlog { 'found inputs to goal', $args{goal}->name, Dumper($lrSourceFiles) } 2;
  0         0  
295              
296             # TODO? verify that all the assets are actually in the graph first?
297 3         39 $self->connect($_, $phony_node) foreach @$lrSourceFiles;
298              
299             } #visit_goal()
300              
301             =head2 visit_node
302              
303             (Optional)
304             Do whatever the generator wants to do with a L<Data::Hopen::G::Node> that
305             is not a Goal (see L</visit_goal>). By default, no-op. Usage:
306              
307             $generator->visit_node($node)
308              
309             =cut
310              
311       9 1   sub visit_node { }
312              
313             1;
314             __END__
315             # vi: set fdm=marker: #