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
|
package DBIx::Class::Factory::Fields;
use strict;
use warnings;
=encoding utf8
=head1 NAME
DBIx::Class::Factory::Fields - fields for DBIx::Class::Factory class
=head1 DESCRIPTION
Every callback used in L<DBIx::Class::Factory> gets a C<DBIx::Class::Factory::Fields> instance as an argument.
=cut
=head1 METHODS
=over
=item B<new>
Constructor. You shouldn't call it explicitly.
=cut
sub new {
my ($class, @params) = @_;
my $instance = bless({}, $class);
$instance->_init(@params);
return $instance;
}
=item B<all>
Returns hashref with all fields that are not excluded
=cut
sub all {
my ($self) = @_;
my %result;
foreach my $field (keys %{$self->{init_fields}}) {
unless (defined $self->{exclude_set}->{$field}) {
$result{$field} = $self->get($field);
}
}
return \%result;
}
=item B<get>
Get the value of the field.
$fields->get('name');
=cut
sub get {
my ($self, $field) = @_;
unless (exists $self->{processed_fields}->{$field}) {
my $value = $self->{init_fields}->{$field};
if (ref($value) eq 'CODE') {
$value = $value->($self);
}
$self->{processed_fields}->{$field} = $value;
}
return $self->{processed_fields}->{$field};
}
=back
=cut
# PRIVATE METHODS
sub _init {
my ($self, $fields, $exclude_set) = @_;
$self->{init_fields} = $fields;
$self->{processed_fields} = {};
$self->{exclude_set} = $exclude_set;
return;
}
=head1 AUTHOR
Vadim Pushtaev, C<pushtaev@cpan.org>
=head1 BUGS AND FEATURES
Bugs are possible, feature requests are welcome. Write me as soon as possible.
=head1 LICENSE AND COPYRIGHT
Copyright 2015 Vadim Pushtaev.
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
1;
|
