File: Command.pm

package info (click to toggle)
libdbix-class-schema-populatemore-perl 0.19-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 400 kB
  • sloc: perl: 3,412; makefile: 2
file content (370 lines) | stat: -rw-r--r-- 6,950 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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
package DBIx::Class::Schema::PopulateMore::Command;

use Moo;
use MooX::HandlesVia;
use List::MoreUtils qw(pairwise);
use DBIx::Class::Schema::PopulateMore::Visitor;
use Module::Pluggable::Object;
use Type::Library -base;
use Types::Standard -types;
use namespace::clean;

=head1 NAME

DBIx::Class::Schema::PopulateMore::Command - Command Class to Populate a Schema

=head1 DESCRIPTION

This is a command pattern  class to manage the job of populating a
L<DBIx::Class::Schema> with information.  We break this out because the
actual job is a bit complex, is likely to grow more complex, and so that
we can more easily identify refactorable and reusable parts.

=head1 ATTRIBUTES

This class defines the following attributes.

=head2 schema

This is the Schema we are populating

=cut

has schema => (
    is=>'ro',
    required=>1,
    isa=>Object,
);

=head2 exception_cb

contains a callback to the exception method supplied by DBIC

=cut

has exception_cb => (
    is=>'ro',
    required=>1,
    isa=>CodeRef,
);

=head2 definitions

This is an arrayref of information used to populate tables in the database

=cut

has definitions => (
    is=>'ro',
    required=>1,
    isa=>ArrayRef[HashRef],
);


=head2 match_condition

How we know the value is really something to inflate or perform a substitution
on.  This get's the namespace of the substitution plugin and it's other data.

=cut

has match_condition => (
    is=>'ro',
    required=>1,
    isa=>RegexpRef, 
    default=>sub {qr/^!(\w+:.+)$/ },
);


=head2 visitor

We define a visitor so that we can perform the value inflations and or 
substitutions.  This is still a little work in progress, but it's getting 
neater

=cut

has visitor => (
    is=>'lazy',
    isa=>InstanceOf['DBIx::Class::Schema::PopulateMore::Visitor'],
    handles => [
        'callback',
        'visit', 
    ],
);


=head2 rs_index

The index of previously inflated resultsets.  Basically when we create a new
row in the table, we cache the result object so that it can be used as a 
dependency in creating another.

Eventually will be moved into the constructor for a plugin

=head2 set_rs_index

Set an index value to an inflated result

=head2 get_rs_index

given an index, returns the related inflated resultset

=cut

has rs_index => (
    is=>'rw',
    handles_via=>'Hash',
    isa=>HashRef[Object],
    default=>sub { +{} },
    handles=> {
        set_rs_index => 'set',
        get_rs_index => 'get',
    },
);


=head2 inflator_loader

Loads each of the available inflators, provider access to the objects

=cut

has inflator_loader => (
    is=>'lazy',
    isa=>InstanceOf['Module::Pluggable::Object'],
    handles=>{
        'inflators' => 'plugins',
    },
);


=head2 inflator_dispatcher

Holds an object that can perform dispatching to the inflators.

=cut

has inflator_dispatcher => (
    is=>'lazy',
    handles_via=>'Hash',
    isa=>HashRef[Object],
    handles=>{
        inflator_list => 'keys',
        get_inflator  => 'get',
    },
);


=head1 METHODS

This module defines the following methods.

=head2 _build_visitor

lazy build for the L</visitor> attribute.

=cut

sub _build_visitor
{
    my $self = shift @_;
    
    DBIx::Class::Schema::PopulateMore::Visitor->new({
        match_condition=>$self->match_condition
    });    
}


=head2 _build_inflator_loader

lazy build for the L</inflator_loader> attribute

=cut

sub _build_inflator_loader
{
    my $self = shift @_;
    
    return Module::Pluggable::Object->new(
        search_path => 'DBIx::Class::Schema::PopulateMore::Inflator',
        require => 1,
        except => 'DBIx::Class::Schema::PopulateMore::Inflator', 
    );    
}


=head2 _build_inflator_dispatcher

lazy build for the L</inflator_dispatcher> attribute

=cut

sub _build_inflator_dispatcher
{
    my $self = shift @_;
    
    my %inflators;
    for my $inflator ($self->inflators)
    {
        my $inflator_obj = $inflator->new;
        my $name = $inflator_obj->name;
        
        $inflators{$name} = $inflator_obj;
        
    }
    
    return \%inflators;
}


=head2 execute

The command classes main method.  Returns a Hash of the created result
rows, where each key is the named index and the value is the row object.

=cut

sub execute
{
    my ($self) = @_;

    foreach my $definition (@{$self->definitions})
    {
        my ($source => $info) = %$definition;
        my @fields = $self->coerce_to_array($info->{fields});
        
        my $data = $self
            ->callback(sub {
                $self->dispatch_inflator(shift);
            })
            ->visit($info->{data});
            
        while( my ($rs_key, $values) = each %{$data} )
        {
            my @values = $self->coerce_to_array($values);
            
            my $new = $self->create_fixture(
                $rs_key => $source,
                $self->merge_fields_values([@fields], [@values])
            );
        }
    }
    
    return %{$self->rs_index};
}


=head2 dispatch_inflator

Dispatch to the correct inflator

=cut

sub dispatch_inflator
{
    my ($self, $arg) = @_;
    my ($name, $command) =  ($arg =~m/^(\w+):(\w.+)$/); 
    
    if( my $inflator = $self->get_inflator($name) )
    {
        $inflator->inflate($self, $command);
    }
    else
    {
        my $available = join(', ', $self->inflator_list);
        $self->exception_cb->("Can't Handle $name, available are: $available");
    }
}


=head2 create_fixture({})

Given a hash suitable for a L<DBIx::Class::Resultset> create method, attempt to
update or create a row in the named source.

returns the newly created row or throws an exception if there is a failure

=cut

sub create_fixture
{
    my ($self, $rs_key => $source, @create) = @_;
    
    my $new = $self
        ->schema
        ->resultset($source)
        ->update_or_create({@create});    
        
    $self->set_rs_index("$source.$rs_key" => $new);
    
    return $new;
}


=head2 merge_fields_values

Given a fields and values, combine to a hash suitable for using in a create_fixture
row statement.

=cut

sub merge_fields_values
{
    my ($self, $fields, $values) = @_;
    
    return pairwise { 
        $self->field_value($a,$b)
    } (@$fields, @$values);    
}


=head2 field_value

Correctly create an array from the fields, values variables, skipping those
where the value is undefined.

=cut

sub field_value
{
    my ($self, $a, $b) = @_;
    
    if(defined $a && defined $b)
    {
        return $a => $b;
    }
    else
    {
        return;
    }
}


=head2 coerce_to_array

given a value that is either an arrayref or a scalar, put it into array context
and return that array.

=cut

sub coerce_to_array
{
    my ($self, $value) = @_;
    
    return ref $value eq 'ARRAY' ? @$value:($value);
}


=head1 AUTHOR

Please see L<DBIx::Class::Schema::PopulateMore> For authorship information

=head1 LICENSE

Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.

=cut


1;