From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

CXW / Build-Hopen-0.000008-TRIAL / lib / Build / Hopen / G / GraphBuilder.pm 

            

              
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
167
168
169
170
171
172
173
174
175
176
177
178
179
180

              
# Build::Hopen::G::GraphBuilder - fluent interface for building graphs
package Build::Hopen::G::GraphBuilder;
use Build::Hopen;
use Build::Hopen::Base;
use Exporter 'import';
our @EXPORT; BEGIN { @EXPORT=qw(make_GraphBuilder); }
our $VERSION = '0.000008'; # TRIAL
use Class::Tiny {
    name => sub { 'ANON' },     # Name is optional; it's here so the
                                # constructor won't croak if you use one.
    dag => undef,
    node => undef,
};
use Class::Method::Modifiers qw(install_modifier);
# Docs {{{1
=head1 NAME
Build::Hopen::G::GraphBuilder - fluent interface for building graphs
=head1 SYNOPSIS
A GraphBuilder wraps a L<Build::Hopen::G::DAG> and a current
L<Build::Hopen::G::Node>.  It permits building chains of nodes in a
fluent way.  For example, in a hopen file:
    # $Build is a Build::Hopen::G::DAG
    use language 'C';
    my $builder = $Build->C::compile(file => 'foo.c');
        # Now $builder holds $Build (the DAG) and a node created by
        # C::compile().
=head1 ATTRIBUTES
=head2 name
An optional name, in case you want to identify your Builder instances.
=head2 dag
The current L<Build::Hopen::G::DAG> instance, if any.
=head2 node
The current L<Build::Hopen::G::Node> instance, if any.
=head1 INSTANCE FUNCTIONS
=cut
# }}}1
=head2 add
Adds a node to the graph.  Returns the node.  Note that this B<does not>
change the builder's current node (L</node>).
=cut
sub add {
    my $self = shift or croak 'Need an instance';
    my $node = shift or croak 'Need a node';
    $self->dag->add($node);
    return $node;
} #add()
=head2 default_goal
Links the most recent node in the chain to the default goal in the DAG.
If the DAG does not have a default goal, adds one called "all".
Clears the builder's record of the current node and returns undef.
=cut
sub default_goal {
    my $self = shift or croak 'Need an instance';
    croak "Need a node to link to the goal" unless $self->node;
    my $goal = $self->dag->default_goal // $self->dag->goal('all');
    $self->dag->add($self->node);   # no harm in it - DAG::add() is idempotent
    $self->dag->connect($self->node, $goal);
    $self->node(undef);     # Less likely to leak state between goals.
    return undef;
        # Return undef because, if this is the last thing in a hopen file,
        # whatever it returns gets recorded in MY.hopen.pl.  Therefore,
        # return $self causes a copy of the whole graph to be dropped into
        # MY.hopen.pl, which is a Bad Thing.
} #default_goal()
=head2 goal
Links the most recent node in the chain to the given goal in the DAG.
Clears the builder's record of the current node and returns undef.
=cut
sub goal {
    my $self = shift or croak 'Need an instance';
    my $goal_name = shift or croak 'Need a goal name';
    croak "Need a node to link to the goal" unless $self->node;
    my $goal = $self->dag->goal($goal_name);
    $self->dag->add($self->node);   # no harm in it - DAG::add() is idempotent
    $self->dag->connect($self->node, $goal);
    $self->node(undef);     # Less likely to leak state between goals.
    return undef;   # undef: See comment in goal()
} #goal()
=head1 STATIC FUNCTIONS
=head2 make_GraphBuilder
Given the name of a subroutine, wrap the given subroutine for use in a
GraphBuilder chain such as that shown in the L</SYNOPSIS>.  Usage:
    sub worker {
        my $graphbuilder = shift;
        ...
        return $node;   # Will automatically be linked into the chain
    }
    make_GraphBuilder 'worker';
        # now worker can take a DAG or GraphBuilder, and the
        # return value will be the GraphBuilder.
The C<worker> subroutine is called in scalar context.
=cut
sub _wrapper;
sub make_GraphBuilder {
    my $target = caller;
    my $funcname = shift or croak 'Need the name of the sub to wrap';   # yum
    install_modifier $target, 'around', $funcname, \&_wrapper;
} #make_GraphBuilder()
# The "around" modifier
sub _wrapper {
    my $orig = shift or die 'Need a function to wrap';
    croak "Need a parameter" unless @_;
    # Create the GraphBuilder if we don't have one already.
    my $self = shift;
    $self = __PACKAGE__->new(dag=>$self)
        unless ref $self and eval { $self->DOES(__PACKAGE__) };
    croak "Parameter must be a DAG or Builder"
        unless $self->dag and eval { $self->dag->DOES('Build::Hopen::G::DAG') };
    unshift @_, $self;     # Put the builder on the arg list
    # Call the worker
    my $worker_retval = &{$orig};   # @_ passed to code
    # If we got a node, remember it.
    if(ref $worker_retval && eval { $worker_retval->DOES('Build::Hopen::G::Node') } ) {
        $self->dag->add($worker_retval);    # Link it into the graph
        $self->dag->connect($self->node, $worker_retval) if $self->node;
        $self->node($worker_retval);        # It's now our current node
    }
    return $self;
}; #_wrapper()
1;
__END__
# vi: set fdm=marker: #