File Coverage

blib/lib/Meta/Builder.pm
Criterion Covered Total %
statement 30 31 96.7
branch n/a
condition 1 3 33.3
subroutine 11 12 91.6
pod 2 2 100.0
total 44 48 91.6


line stmt bran cond sub pod time code
1             package Meta::Builder;
2 2     2   82783 use strict;
  2         5  
  2         68  
3 2     2   9 use warnings;
  2         4  
  2         60  
4              
5 2     2   10 use Carp qw/croak/;
  2         9  
  2         115  
6 2     2   1014 use Meta::Builder::Util;
  2         5  
  2         20  
7 2     2   1815 use Meta::Builder::Base;
  2         6  
  2         871  
8              
9             our $VERSION = "0.003";
10              
11             our @SUGAR = qw/metric action hash_metric lists_metric/;
12             our @HOOKS = qw/before after/;
13             our @METHODS = (( map { "add_$_" } @SUGAR ),
14             ( map { "hook_$_" } @HOOKS ));
15             our @EXPORT = ( @SUGAR, @HOOKS, qw/make_immutable accessor/ );
16             our @REMOVABLE = ( @EXPORT, @METHODS );
17              
18             for my $item ( @SUGAR ) {
19             my $wraps = "add_$item";
20             inject( __PACKAGE__, $item, sub {
21 6     6   50 caller->$wraps(@_)
22             });
23             }
24              
25             for my $item ( @HOOKS ) {
26             my $wraps = "hook_$item";
27             inject( __PACKAGE__, $item, sub {
28 0     0   0 caller->$wraps(@_)
29             });
30             }
31              
32             sub import {
33 2     2   11535 my $class = shift;
34 2         14 my $caller = caller;
35              
36 2         64 inject( $caller, $_, $class->can( $_ )) for @EXPORT;
37 2     2   18 no strict 'refs';
  2         4  
  2         469  
38 2         5 push @{"$caller\::ISA"} => 'Meta::Builder::Base';
  2         2504  
39             }
40              
41             sub make_immutable {
42 1   33 1 1 576 my $class = shift || caller;
43 1         4 for my $sub ( @REMOVABLE ) {
44             inject( $class, $sub, sub {
45 14     14   13153 croak "$class has been made immutable, cannot call '$sub'"
46 14         71 }, 1 );
47             }
48             }
49              
50             sub accessor {
51 2     2 1 1885 my $class = caller;
52 2         66 $class->set_accessor( @_ );
53             }
54              
55             1;
56              
57             __END__
58              
59             =head1 NAME
60              
61             Meta::Builder - Tools for creating Meta objects to track custom metrics.
62              
63             =head1 DESCRIPTION
64              
65             Meta programming is becomming more and more popular. The popularity of Meta
66             programming comes from the fact that many problems are made significantly
67             easier. There are a few specialized Meta tools out there, for instance
68             L<Class:MOP> which is used by L<Moose> to track class metadata.
69              
70             Meta::Builder is designed to be a generic tool for writing Meta objects. Unlike
71             specialized tools, Meta::Builder makes no assumptions about what metrics you
72             will care about. Meta::Builder also mkaes it simple for others to extend your
73             meta-object based tools by providing hooks for other packages to add metrics to
74             your meta object.
75              
76             If a specialized Meta object tool is available ot meet your needs please use
77             it. However if you need a simple Meta object to track a couple metrics, use
78             Meta::Builder.
79              
80             Meta::Builder is also low-sugar and low-dep. In most cases you will not want a
81             class that needs a meta object to use your meta-object class directly. Rather
82             you will usually want to create a sugar class that exports enhanced API
83             functions that manipulate the meta object.
84              
85             =head1 SYNOPSIS
86              
87             My/Meta.pm:
88              
89             package My::Meta;
90             use strict;
91             use warnings;
92              
93             use Meta::Builder;
94              
95             # Name the accessor that will be defined in the class that uses the meta object
96             # It is used to retrieve the classes meta object.
97             accessor "mymeta";
98              
99             # Add a metric with two actions
100             metric mymetric => sub { [] },
101             pop => sub {
102             my $self = shift;
103             my ( $data ) = @_;
104             pop @$data;
105             },
106             push => sub {
107             my $self = shift;
108             my ( $data, $metric, $action, @args ) = @_;
109             push @$data => @args;
110             };
111              
112             # Add an additional action to the metric
113             action mymetric => ( get_ref => sub { shift });
114              
115             # Add some predefined metric types + actions
116             hash_metric 'my_hashmetric';
117             lists_metric 'my_listsmetric';
118              
119             My.pm:
120              
121             package My;
122             use strict;
123             use warnings;
124              
125             use My::Meta;
126              
127             My::Meta->new( __PACKAGE__ );
128              
129             # My::Meta defines mymeta() as the accessor we use to get our meta object.
130             # this is the ONLY way to get the meta object for this class.
131              
132             mymeta()->mymetric_push( "some data" );
133             mymeta()->my_hashmetric_add( key => 'value' );
134             mymeta()->my_listsmetric_push( list => qw/valueA valueB/ );
135              
136             # It works fine as an object/class method as well.
137             __PACKAGE__->mymeta->do_thing(...);
138              
139             ...;
140              
141             =head1 USING
142              
143             When you use Meta::Builder your class is automatically turned into a subclass
144             of L<Meta::Builder::Base>. In addition several "sugar" functions are exported
145             into your namespace. To avoid the "sugar" functions you can simply sublass
146             L<Meta::Builder::Base> directly.
147              
148             =head1 EXPORTS
149              
150             =over 4
151              
152             =item metric( $name, \&generator, %actions )
153              
154             Wraper around C<caller->add_metric()>. See L<Meta::Builder::Base>.
155              
156             =item action( $metric, $name, $code )
157              
158             Wraper around C<caller->add_action()>. See L<Meta::Builder::Base>.
159              
160             =item hash_metric( $name, %additional_actions )
161              
162             Wraper around C<caller->add_hash_metric()>. See L<Meta::Builder::Base>.
163              
164             =item lists_metric( $name, %additional_actions )
165              
166             Wraper around C<caller->add_lists_metric()>. See L<Meta::Builder::Base>.
167              
168             =item before( $metric, $action, $code )
169              
170             Wraper around C<caller->hook_before()>. See L<Meta::Builder::Base>.
171              
172             =item after( $metric, $action, $code )
173              
174             Wraper around C<caller->hook_after()>. See L<Meta::Builder::Base>.
175              
176             =item accessor( $name )
177              
178             Wraper around C<caller->set_accessor()>. See L<Meta::Builder::Base>.
179              
180             =item make_immutable()
181              
182             Overrides all functions/methods that alter the meta objects meta-data. This in
183             effect prevents anything from adding new metrics, actions, or hooks without
184             directly editing the metadata.
185              
186             =back
187              
188             =head1 AUTHORS
189              
190             Chad Granum L<exodist7@gmail.com>
191              
192             =head1 COPYRIGHT
193              
194             Copyright (C) 2010 Chad Granum
195              
196             Meta-Builder is free software; Standard perl licence.
197              
198             Meta-Builder is distributed in the hope that it will be useful, but WITHOUT
199             ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
200             FOR A PARTICULAR PURPOSE. See the license for more details.