File: Plan.pm

package info (click to toggle)
libextutils-builder-perl 0.017-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 276 kB
  • sloc: perl: 1,351; makefile: 2
file content (166 lines) | stat: -rw-r--r-- 3,692 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
package ExtUtils::Builder::Plan;
$ExtUtils::Builder::Plan::VERSION = '0.017';
use strict;
use warnings;

use Carp ();
use Scalar::Util ();

sub new {
	my ($class, %args) = @_;
	return bless {
		nodes => $args{nodes} // {}
	}, $class;
}

sub node {
	my ($self, $name) = @_;
	return $self->{nodes}{$name};
}

sub nodes {
	my $self = shift;
	return @{$self->{nodes}}{ $self->node_names };
}

sub node_names {
	my $self = shift;
	return sort keys %{ $self->{nodes} };
}

sub _node_sorter {
	my ($self, $name, $callback, $seen, $loop) = @_;
	Carp::croak("$name has a circular dependency, aborting!\n") if exists $loop->{$name};
	return if $seen->{$name}++;
	if (my $node = $self->{nodes}{$name}) {
		local $loop->{$name} = 1;
		$self->_node_sorter($_, $callback, $seen, $loop) for $node->dependencies;
		$callback->($name, $node);
	} elsif (not -e $name) {
		Carp::confess("Node $name doesn't exist")
	}
	return;
}

sub run {
	my ($self, $targets, %options) = @_;

	my @targets = ref($targets) ? @{$targets} : $targets;
	my (%seen, %loop);
	my $run_node = sub {
		my ($name, $node) = @_;
		return if $self->_up_to_date($node);
		$node->execute(%options);
	};
	$self->_node_sorter($_, $run_node, \%seen, \%loop) for @targets;
	return;
}

sub _up_to_date {
	my ($self, $node) = @_;
	return 0 if $node->type eq 'phony' or not -e $node->target;
	my $mtime = -M _;
	for my $dep_name (sort $node->dependencies) {
		if (my $dep = $self->{nodes}{$dep_name}) {
			return 0 unless $dep->newer_than($mtime);
		} else {
			return 0 unless -e $dep_name && $mtime <= -M _;
		}
	}
	return 1;
}

sub merge {
	my ($self, $other) = @_;
	Carp::croak('Right side of merge is not a Plan') if not $other->isa(__PACKAGE__);
	my $double = join ', ', grep { $other->{nodes}{$_} } keys %{ $self->{nodes} };
	Carp::croak("Found key(s) $double on both sides of merge") if $double;
	my %nodes = (%{ $self->{nodes} }, %{ $other->{nodes} });
	return ref($self)->new(nodes => [ values %nodes ]);
}

sub phonies {
	my ($self) = @_;
	return sort map { $_->target } grep { $_->phony } values %{ $self->{nodes} };
}

1;

# ABSTRACT: An ExtUtils::Builder Plan

__END__

=pod

=encoding UTF-8

=head1 NAME

ExtUtils::Builder::Plan - An ExtUtils::Builder Plan

=head1 VERSION

version 0.017

=head1 SYNOPSIS

 package Frobnicate;
 sub plan {
     my %nodes = ...;
     return ExtUtils::Builder::Plan->new(
         nodes => \%nodes,
     );
 }

 my $plan = Frobnicate->plan(@args);
 
 # various consumption methods
 $plan->run('foo');
 say $_->target for $plan->nodes;

=head1 DESCRIPTION

An object of this class describes a process. It contains one or more nodes. This is enough to describe whole building processes, in fact its C<run> method is a tiny C<make> engine.

=head1 ATTRIBUTES

=head2 nodes

This is the set of all nodes in this plan.

=head1 METHODS

=head2 run($target, %options)

This runs the process. Similar to C<make>, it checks for each node if it is necessary to run, and if not skips it. C<$target> may either be a single string or an array ref of strings for the targets to run.

=head2 node($target)

Returns the node for the specified C<$target>.

=head2 node_names()

Returns the names of all the nodes.

=head2 merge($other)

This merges this plan with another, and returns the new plan. Each entry may only exist on one side of the merge.

=head2 phonies()

This returns the names of all phony targets.

=for Pod::Coverage new

=head1 AUTHOR

Leon Timmermans <fawaka@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Leon Timmermans.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut