Meta-Builder-0.003000755003720003720 011454203725 14310 5ustar00exodistexodist000000000000Meta-Builder-0.003/README000444003720003720 1052711454203725 15352 0ustar00exodistexodist000000000000NAME Meta::Builder - Tools for creating Meta objects to track custom metrics. DESCRIPTION Meta programming is becomming more and more popular. The popularity of Meta programming comes from the fact that many problems are made significantly easier. There are a few specialized Meta tools out there, for instance which is used by Moose to track class metadata. Meta::Builder is designed to be a generic tool for writing Meta objects. Unlike specialized tools, Meta::Builder makes no assumptions about what metrics you will care about. Meta::Builder also mkaes it simple for others to extend your meta-object based tools by providing hooks for other packages to add metrics to your meta object. If a specialized Meta object tool is available ot meet your needs please use it. However if you need a simple Meta object to track a couple metrics, use Meta::Builder. Meta::Builder is also low-sugar and low-dep. In most cases you will not want a class that needs a meta object to use your meta-object class directly. Rather you will usually want to create a sugar class that exports enhanced API functions that manipulate the meta object. SYNOPSIS My/Meta.pm: package My::Meta; use strict; use warnings; use Meta::Builder; # Name the accessor that will be defined in the class that uses the meta object # It is used to retrieve the classes meta object. accessor "mymeta"; # Add a metric with two actions metric mymetric => sub { [] }, pop => sub { my $self = shift; my ( $data ) = @_; pop @$data; }, push => sub { my $self = shift; my ( $data, $metric, $action, @args ) = @_; push @$data => @args; }; # Add an additional action to the metric action mymetric => ( get_ref => sub { shift }); # Add some predefined metric types + actions hash_metric 'my_hashmetric'; lists_metric 'my_listsmetric'; My.pm: package My; use strict; use warnings; use My::Meta; My::Meta->new( __PACKAGE__ ); # My::Meta defines mymeta() as the accessor we use to get our meta object. # this is the ONLY way to get the meta object for this class. mymeta()->mymetric_push( "some data" ); mymeta()->my_hashmetric_add( key => 'value' ); mymeta()->my_listsmetric_push( list => qw/valueA valueB/ ); # It works fine as an object/class method as well. __PACKAGE__->mymeta->do_thing(...); ...; USING When you use Meta::Builder your class is automatically turned into a subclass of Meta::Builder::Base. In addition several "sugar" functions are exported into your namespace. To avoid the "sugar" functions you can simply sublass Meta::Builder::Base directly. EXPORTS metric( $name, \&generator, %actions ) Wraper around "caller-"add_metric()>. See Meta::Builder::Base. action( $metric, $name, $code ) Wraper around "caller-"add_action()>. See Meta::Builder::Base. hash_metric( $name, %additional_actions ) Wraper around "caller-"add_hash_metric()>. See Meta::Builder::Base. lists_metric( $name, %additional_actions ) Wraper around "caller-"add_lists_metric()>. See Meta::Builder::Base. before( $metric, $action, $code ) Wraper around "caller-"hook_before()>. See Meta::Builder::Base. after( $metric, $action, $code ) Wraper around "caller-"hook_after()>. See Meta::Builder::Base. accessor( $name ) Wraper around "caller-"set_accessor()>. See Meta::Builder::Base. make_immutable() Overrides all functions/methods that alter the meta objects meta-data. This in effect prevents anything from adding new metrics, actions, or hooks without directly editing the metadata. AUTHORS Chad Granum exodist7@gmail.com COPYRIGHT Copyright (C) 2010 Chad Granum Meta-Builder is free software; Standard perl licence. Meta-Builder is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Meta-Builder-0.003/Build.PL000444003720003720 120611454203725 15740 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'Meta::Builder', license => 'perl', dist_author => 'Chad Granum ', create_readme => 1, requires => { Carp => 0, }, build_requires => { 'Fennec::Lite' => "", 'Test::More' => "", 'Test::Exception' => "", }, meta_merge => { resources => { repository => 'http://github.com/exodist/Meta-Builder', bugtracker => 'http://github.com/exodist/Meta-Builder/issues', }, } ); $build->create_build_script; Meta-Builder-0.003/META.yml000444003720003720 143311454203725 15717 0ustar00exodistexodist000000000000--- abstract: 'Tools for creating Meta objects to track custom metrics.' author: - 'Chad Granum ' build_requires: Fennec::Lite: '' Test::Exception: '' Test::More: '' configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3603' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Meta-Builder provides: Meta::Builder: file: lib/Meta/Builder.pm version: 0.003 Meta::Builder::Base: file: lib/Meta/Builder/Base.pm Meta::Builder::Util: file: lib/Meta/Builder/Util.pm requires: Carp: 0 resources: bugtracker: http://github.com/exodist/Meta-Builder/issues license: http://dev.perl.org/licenses/ repository: http://github.com/exodist/Meta-Builder version: 0.003 Meta-Builder-0.003/MANIFEST000444003720003720 22311454203725 15553 0ustar00exodistexodist000000000000Build.PL lib/Meta/Builder.pm lib/Meta/Builder/Base.pm lib/Meta/Builder/Util.pm MANIFEST This list of files META.yml README t/Builder.t t/Merge.t Meta-Builder-0.003/t000755003720003720 011454203725 14553 5ustar00exodistexodist000000000000Meta-Builder-0.003/t/Builder.t000444003720003720 1133011454203725 16501 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; our $CLASS; BEGIN { $CLASS = 'Meta::Builder'; require_ok $CLASS; } { package MyMeta; use Meta::Builder; use Fennec::Lite; isa_ok( __PACKAGE__, "Meta::Builder::Base" ); can_ok( __PACKAGE__, qw/ metric action before after add_metric add_action hook_before hook_after accessor new make_immutable add_lists_metric add_hash_metric lists_metric hash_metric / ); accessor 'mymeta'; metric mymetric => sub { [] }, pop => sub { my $self = shift; my ( $data ) = @_; pop @$data; }; action mymetric => push => sub { my $self = shift; my ( $data, $metric, $action, @args ) = @_; push @$data => @args; }; hash_metric 'myhash'; lists_metric 'mylists'; # These actions should all have been added can_ok( __PACKAGE__, qw/ mymetric myhash mylists mymetric_pop mymetric_push myhash_add myhash_clear myhash_get myhash_has myhash_pull mylists_push mylists_clear mylists_get mylists_has mylists_pull /); } my $meta = MyMeta->new( __PACKAGE__ ); tests meta_applied => sub { is( $meta, mymeta(), "Got meta" ); is( $meta->package, __PACKAGE__, "Meta applied to correct package" ); }; tests mymetric => sub { isa_ok( $meta->mymetric, 'ARRAY' ); is_deeply( $meta->mymetric, [], "mymetric empty" ); $meta->mymetric_push( 'a', 'b' ); is_deeply( $meta->mymetric, [qw/a b/], "mymetric filled" ); is( $meta->mymetric_pop(), 'b', "popped mymetric" ); is_deeply( $meta->mymetric, ['a'], "mymetric altered" ); }; tests myhash => sub { isa_ok( $meta->myhash, 'HASH' ); is_deeply( $meta->myhash, {}, "myhash empty" ); $meta->myhash_add( 'a', 'b' ); is_deeply( $meta->myhash, { a => 'b' }, "myhash filled" ); is( $meta->myhash_get('a'), 'b', "got from myhash" ); ok( $meta->myhash_has( 'a' ), "have 'a'" ); ok( !$meta->myhash_has( 'b' ), "don't have 'b'" ); $meta->myhash_add( 'c', 'd' ); $meta->myhash_clear( 'a' ); is_deeply( $meta->myhash, { c => 'd' }, "myhash filled" ); $meta->myhash_add( 'a', 'b' ); is_deeply( $meta->myhash_pull( 'a' ), 'b', "pulled" ); is_deeply( $meta->myhash, { c => 'd' }, "myhash filled" ); }; tests mylists => sub { isa_ok( $meta->mylists, 'HASH' ); is_deeply( $meta->mylists, {}, "mylists empty" ); $meta->mylists_push( 'a', 'b', 'c', 'd' ); is_deeply( $meta->mylists, { a => [qw/b c d/] }, "mylists filled" ); is_deeply( [$meta->mylists_get('a')], [qw/b c d/], "got from mylists" ); ok( $meta->mylists_has( 'a' ), "have 'a'" ); ok( !$meta->mylists_has( 'b' ), "don't have 'b'" ); $meta->mylists_push( 'c', 'd', 'e', 'f' ); $meta->mylists_clear( 'a' ); is_deeply( $meta->mylists, { c => [qw/d e f/] }, "mylists filled" ); $meta->mylists_push( 'a', 'b' ); is_deeply( [$meta->mylists_pull( 'a' )], ['b'], "pulled" ); is_deeply( $meta->mylists, { c => [qw/d e f/] }, "mylists filled" ); }; tests external_adding => sub { MyMeta->add_metric( 'a' ); MyMeta->add_action( 'a', 'do', sub {} ); MyMeta->add_hash_metric( 'b' ); MyMeta->add_lists_metric( 'c' ); can_ok( 'MyMeta', qw/ a b c a_do b_add b_clear b_get b_has b_pull c_push c_clear c_get c_has c_pull /); }; run_tests(); tests hooks => sub { MyMeta->hook_before( 'mylists', 'push', sub { my $self = shift; my ( $data, $metric, $action, $key, @values ) = @_; die "can't add values to list 'x'" if $key eq 'x'; }); MyMeta->hook_after( 'mylists', 'push', sub { my $self = shift; my ( $data, $metric, $action, $key, @values ) = @_; die "can't add values to list 'y'" if $key eq 'y'; }); ok( ! $meta->mylists_has( 'x' ), "No 'x'" ); throws_ok { $meta->mylists_push( x => 'a' ) } qr/can't add values to list 'x'/, "before hook was triggered"; ok( ! $meta->mylists_has( 'x' ), "triggered before push" ); ok( ! $meta->mylists_has( 'y' ), "No 'y'" ); throws_ok { $meta->mylists_push( y => 'a' ) } qr/can't add values to list 'y'/, "after hook was triggered"; ok( $meta->mylists_has( 'y' ), "triggered after push" ); }; run_tests(); tests immutibility => sub { MyMeta->make_immutable; throws_ok { MyMeta->$_ } qr/MyMeta has been made immutable, cannot call '$_'/, "$_ cannot be called when immutable" for qw/ metric action before after add_metric add_action hook_before hook_after accessor make_immutable add_lists_metric add_hash_metric lists_metric hash_metric /; }; run_tests(); done_testing; Meta-Builder-0.003/t/Merge.t000444003720003720 237211454203725 16140 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; our $CLASS; BEGIN { $CLASS = 'Meta::Builder'; require_ok $CLASS; } { package MyMeta; use Meta::Builder; accessor 'mymeta'; hash_metric 'myhash'; lists_metric 'mylists'; } tests merge => sub { my $meta = MyMeta->new( 'FAKEA' ); my $other = MyMeta->new( 'FAKEB' ); $meta->myhash_add( 'a' => 'b' ); $meta->myhash_add( 'b' => 'c' ); $meta->mylists_push( a => qw/a b c/ ); $other->myhash_add( 'c' => 'd' ); $other->myhash_add( 'd' => 'e' ); $other->mylists_push( a => qw/d e f/ ); $meta->merge( $other ); is_deeply( $meta->myhash, { a => 'b', b => 'c', c => 'd', d => 'e', }, "Merged hash", ); is_deeply( $meta->mylists, { a => [qw/a b c d e f/] }, "Merged lists", ); }; tests fail => sub { my $meta = MyMeta->new( 'FAKEC' ); my $other = MyMeta->new( 'FAKED' ); $meta->myhash_add( 'a' => 'b' ); $other->myhash_add( 'a' => 'd' ); throws_ok { $meta->merge( $other )} qr/a is defined for myhash in both meta-objects/, "Cannot merge hashes with the same keys"; }; run_tests(); done_testing; Meta-Builder-0.003/lib000755003720003720 011454203725 15056 5ustar00exodistexodist000000000000Meta-Builder-0.003/lib/Meta000755003720003720 011454203725 15744 5ustar00exodistexodist000000000000Meta-Builder-0.003/lib/Meta/Builder.pm000444003720003720 1246111454203725 20051 0ustar00exodistexodist000000000000package Meta::Builder; use strict; use warnings; use Carp qw/croak/; use Meta::Builder::Util; use Meta::Builder::Base; our $VERSION = "0.003"; our @SUGAR = qw/metric action hash_metric lists_metric/; our @HOOKS = qw/before after/; our @METHODS = (( map { "add_$_" } @SUGAR ), ( map { "hook_$_" } @HOOKS )); our @EXPORT = ( @SUGAR, @HOOKS, qw/make_immutable accessor/ ); our @REMOVABLE = ( @EXPORT, @METHODS ); for my $item ( @SUGAR ) { my $wraps = "add_$item"; inject( __PACKAGE__, $item, sub { caller->$wraps(@_) }); } for my $item ( @HOOKS ) { my $wraps = "hook_$item"; inject( __PACKAGE__, $item, sub { caller->$wraps(@_) }); } sub import { my $class = shift; my $caller = caller; inject( $caller, $_, $class->can( $_ )) for @EXPORT; no strict 'refs'; push @{"$caller\::ISA"} => 'Meta::Builder::Base'; } sub make_immutable { my $class = shift || caller; for my $sub ( @REMOVABLE ) { inject( $class, $sub, sub { croak "$class has been made immutable, cannot call '$sub'" }, 1 ); } } sub accessor { my $class = caller; $class->set_accessor( @_ ); } 1; __END__ =head1 NAME Meta::Builder - Tools for creating Meta objects to track custom metrics. =head1 DESCRIPTION Meta programming is becomming more and more popular. The popularity of Meta programming comes from the fact that many problems are made significantly easier. There are a few specialized Meta tools out there, for instance L which is used by L to track class metadata. Meta::Builder is designed to be a generic tool for writing Meta objects. Unlike specialized tools, Meta::Builder makes no assumptions about what metrics you will care about. Meta::Builder also mkaes it simple for others to extend your meta-object based tools by providing hooks for other packages to add metrics to your meta object. If a specialized Meta object tool is available ot meet your needs please use it. However if you need a simple Meta object to track a couple metrics, use Meta::Builder. Meta::Builder is also low-sugar and low-dep. In most cases you will not want a class that needs a meta object to use your meta-object class directly. Rather you will usually want to create a sugar class that exports enhanced API functions that manipulate the meta object. =head1 SYNOPSIS My/Meta.pm: package My::Meta; use strict; use warnings; use Meta::Builder; # Name the accessor that will be defined in the class that uses the meta object # It is used to retrieve the classes meta object. accessor "mymeta"; # Add a metric with two actions metric mymetric => sub { [] }, pop => sub { my $self = shift; my ( $data ) = @_; pop @$data; }, push => sub { my $self = shift; my ( $data, $metric, $action, @args ) = @_; push @$data => @args; }; # Add an additional action to the metric action mymetric => ( get_ref => sub { shift }); # Add some predefined metric types + actions hash_metric 'my_hashmetric'; lists_metric 'my_listsmetric'; My.pm: package My; use strict; use warnings; use My::Meta; My::Meta->new( __PACKAGE__ ); # My::Meta defines mymeta() as the accessor we use to get our meta object. # this is the ONLY way to get the meta object for this class. mymeta()->mymetric_push( "some data" ); mymeta()->my_hashmetric_add( key => 'value' ); mymeta()->my_listsmetric_push( list => qw/valueA valueB/ ); # It works fine as an object/class method as well. __PACKAGE__->mymeta->do_thing(...); ...; =head1 USING When you use Meta::Builder your class is automatically turned into a subclass of L. In addition several "sugar" functions are exported into your namespace. To avoid the "sugar" functions you can simply sublass L directly. =head1 EXPORTS =over 4 =item metric( $name, \&generator, %actions ) Wraper around Cadd_metric()>. See L. =item action( $metric, $name, $code ) Wraper around Cadd_action()>. See L. =item hash_metric( $name, %additional_actions ) Wraper around Cadd_hash_metric()>. See L. =item lists_metric( $name, %additional_actions ) Wraper around Cadd_lists_metric()>. See L. =item before( $metric, $action, $code ) Wraper around Chook_before()>. See L. =item after( $metric, $action, $code ) Wraper around Chook_after()>. See L. =item accessor( $name ) Wraper around Cset_accessor()>. See L. =item make_immutable() Overrides all functions/methods that alter the meta objects meta-data. This in effect prevents anything from adding new metrics, actions, or hooks without directly editing the metadata. =back =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Meta-Builder is free software; Standard perl licence. Meta-Builder is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Meta-Builder-0.003/lib/Meta/Builder000755003720003720 011454203725 17332 5ustar00exodistexodist000000000000Meta-Builder-0.003/lib/Meta/Builder/Base.pm000444003720003720 3400011454203725 20714 0ustar00exodistexodist000000000000package Meta::Builder::Base; use strict; use warnings; use Meta::Builder::Util; use Carp qw/croak carp/; sub new { my $class = shift; my ( $package, %metrics ) = @_; my $meta = $class->meta_meta; my $self = bless( [ $package ], $class ); for my $metric ( keys %{ $meta->{metrics} }) { my $idx = $meta->{metrics}->{$metric}; $self->[$idx] = $metrics{$metric} || $meta->{generators}->[$idx]->(); } inject( $package, ($meta->{accessor} || croak "$class does not have an accessor set."), sub { $self } ); $self->init( %metrics ) if $self->can( 'init' ); return $self; } sub meta_meta { my $class = shift; return $class->_meta_meta if $class->can( '_meta_meta' ); my $meta = { index => 1 }; inject( $class, "_meta_meta", sub { $meta }); return $meta; } sub package { shift->[0] } sub set_accessor { my $class = shift; ($class->meta_meta->{accessor}) = @_; } sub add_hash_metric { my $class = shift; my ( $metric, %actions ) = @_; $class->add_metric( $metric, \&gen_hash, add => \&default_hash_add, get => \&default_hash_get, has => \&default_hash_has, clear => \&default_hash_clear, pull => \&default_hash_pull, merge => \&default_hash_merge, %actions, ); } sub add_lists_metric { my $class = shift; my ( $metric, %actions ) = @_; $class->add_metric( $metric, \&gen_hash, push => \&default_list_push, get => \&default_list_get, has => \&default_list_has, clear => \&default_list_clear, pull => \&default_list_pull, merge => \&default_list_merge, %actions, ); } sub add_metric { my $class = shift; my ( $metric, $generator, %actions ) = @_; my $meta = $class->meta_meta; my $index = $meta->{index}++; croak "Already tracking metric '$metric'" if $meta->{metrics}->{$metric}; $meta->{metrics}->{$metric} = $index; $meta->{generators}->[$index] = $generator; $meta->{indexes}->{$index} = $metric; inject( $class, $metric, sub { shift->[$index] }); $class->add_action( $metric, %actions ); } sub add_action { my $class = shift; my ( $metric, %actions ) = @_; $class->_add_action( $metric, $_, $actions{ $_ }) for keys %actions; } sub _add_action { my $class = shift; my ( $metric, $action, $code ) = @_; croak "You must specify a metric, an action name, and a coderef" unless $metric && $action && $code; my $meta = $class->meta_meta; my $name = $class->action_method_name( $metric, $action ); inject( $class, $name, sub { my $self = shift; my $args = \@_; $_->( $self, $self->$metric, $metric, $action, @$args ) for @{ $meta->{before}->{$name} || [] }; my @out = $code->( $self, $self->$metric, $metric, $action, @$args ); $_->( $self, $self->$metric, $metric, $action, @$args ) for @{ $meta->{after}->{$name} || [] }; return @out ? (@out > 1 ? @out : $out[0]) : (); }); } sub action_method_name { my $class = shift; my ( $metric, $action ) = @_; return "$metric\_$action"; } sub hook_before { my $class = shift; my ( $metric, $action, $code ) = @_; my $name = $class->action_method_name( $metric, $action ); push @{ $class->meta_meta->{before}->{$name} } => $code; } sub hook_after { my $class = shift; my ( $metric, $action, $code ) = @_; my $name = $class->action_method_name( $metric, $action ); push @{ $class->meta_meta->{after}->{$name} } => $code; } sub gen_hash { {} } sub default_hash_add { my $self = shift; my ( $data, $metric, $action, $item, @value ) = @_; my $name = $self->action_method_name( $metric, $action ); croak "$name() called without anything to add" unless $item; croak "$name('$item') called without a value to add" unless @value; croak "'$item' already added for metric $metric" if $data->{$item}; ($data->{$item}) = @value; } sub default_hash_get { my $self = shift; my ( $data, $metric, $action, $item ) = @_; my $name = $self->action_method_name( $metric, $action ); croak "$name() called without anything to get" unless $item; # Prevent autovivication return exists $data->{$item} ? $data->{$item} : undef; } sub default_hash_has { my $self = shift; my ( $data, $metric, $action, $item ) = @_; my $name = $self->action_method_name( $metric, $action ); croak "$name() called without anything to find" unless $item; return exists $data->{$item} ? 1 : 0; } sub default_hash_clear { my $self = shift; my ( $data, $metric, $action, $item ) = @_; my $name = $self->action_method_name( $metric, $action ); croak "$name() called without anything to clear" unless $item; delete $data->{$item}; return 1; } sub default_hash_pull { my $self = shift; my ( $data, $metric, $action, $item ) = @_; my $name = $self->action_method_name( $metric, $action ); croak "$name() called without anything to pull" unless $item; return delete $data->{$item}; } sub default_hash_merge { my $self = shift; my ( $data, $metric, $action, $merge ) = @_; for my $key ( keys %$merge ) { croak "$key is defined for $metric in both meta-objects" if $data->{$key}; $data->{$key} = $merge->{$key}; } } sub default_list_push { my $self = shift; my ( $data, $metric, $action, $item, @values ) = @_; my $name = $self->action_method_name( $metric, $action ); croak "$name() called without an item to which data should be pushed" unless $item; croak "$name('$item') called without values to push" unless @values; push @{$data->{$item}} => @values; } sub default_list_get { my $data = default_hash_get(@_); return $data ? @$data : (); } sub default_list_has { default_hash_has( @_ ); } sub default_list_clear { default_hash_clear( @_ ); } sub default_list_pull { my @out = default_list_get( @_ ); default_list_clear( @_ ); return @out; } sub default_list_merge { my $self = shift; my ( $data, $metric, $action, $merge ) = @_; for my $key ( keys %$merge ) { push @{ $data->{$key} } => @{ $merge->{$key} }; } } sub merge { my $self = shift; my ( $merge ) = @_; for my $metric ( keys %{ $self->meta_meta->{ metrics }}) { my $mergesub = $self->action_method_name( $metric, 'merge' ); unless( $self->can( $mergesub )) { carp "Cannot merge metric '$metric', define a 'merge' action for it."; next; } $self->$mergesub( $merge->$metric ); } } 1; __END__ =head1 NAME Meta::Builder::Base - Base class for Meta::Builder Meta Objects. =head1 DESCRIPTION Base class for all L Meta objects. This is where the methods used to define new metrics and actions live. This class allows for the creation of dynamic meta objects. =head1 SYNOPSIS My/Meta.pm: package My::Meta; use strict; use warnings; use base 'Meta::Builder::Base'; # Name the accessor that will be defined in the class that uses the meta object # It is used to retrieve the classes meta object. __PACKAGE__->set_accessor( "mymeta" ); # Add a metric with two actions __PACKAGE__->add_metric( mymetric => sub { [] }, pop => sub { my $self = shift; my ( $data ) = @_; pop @$data; }, push => sub { my $self = shift; my ( $data, $metric, $action, @args ) = @_; push @$data => @args; } ); # Add an additional action to the metric __PACKAGE__->add_action( 'mymetric', get_ref => sub { shift }); # Add some predefined metric types + actions __PACKAGE__->add_hash_metric( 'my_hashmetric' ); __PACKAGE__->add_lists_metric( 'my_listsmetric' ); My.pm: package My; use strict; use warnings; use My::Meta; My::Meta->new( __PACKAGE__ ); # My::Meta defines mymeta() as the accessor we use to get our meta object. # this is the ONLY way to get the meta object for this class. mymeta()->mymetric_push( "some data" ); mymeta()->my_hashmetric_add( key => 'value' ); mymeta()->my_listsmetric_push( list => qw/valueA valueB/ ); # It works fine as an object/class method as well. __PACKAGE__->mymeta->do_thing(...); ...; =head1 PACKAGE METRIC Whenever you create a new instance of a meta-object you must provide the name of the package to which the meta-object belongs. The 'package' metric will be set to this package name, and can be retirved via the 'package' method: C<$meta->package()>. =head1 HASH METRICS Hash metrics are metrics that hold key/value pairs. A hash metric is defined using either the C function, or the C<$meta->add_hash_metric()> method. The following actions are automatically defined for hash metrics: =over 4 =item $meta->add_METRIC( $key, $value ) Add a key/value pair to the metric. Will throw an exception if the metric already has a value for the specified key. =item $value = $meta->get_METRIC( $key ) Get the value for a specified key. =item $bool = $meta->has_METRIC( $key ) Check that the metric has the specified key defined. =item $meta->clear_METRIC( $key ) Clear the specified key/value pair in the metric. (returns nothing) =item $value = $meta->pull_METRIC( $key ) Get the value for the specified key, then clear the pair form the metric. =back =head1 LISTS METRICS =over 4 =item $meta->push_METRIC( $key, @values ) Push values into the specified list for the given metric. =item @values = $meta->get_METRIC( $key ) Get the values for a specified key. =item $bool = $meta->has_METRIC( $key ) Check that the metric has the specified list. =item $meta->clear_METRIC( $key ) Clear the specified list in the metric. (returns nothing) =item @values = $meta->pull_METRIC( $key ) Get the values for the specified list in the metric, then clear the list. =back =head1 CLASS METHODS =over 4 =item $meta = $class->new( $package, %metrics ) Create a new instance of the meta-class, and apply it to $package. =item $metadata = $class->meta_meta() Get the meta data for the meta-class itself. (The meta-class is build using meta-data) =item $new_hashref = $class->gen_hash() Generate a new empty hashref. =item $name = $class->action_method_name( $metric, $action ) Generate the name of the method for the given metric and action. Override this if you do not like the METRIC_ACTION() method names. =back =head1 OBJECT METHODS =over 4 =item $package = $meta->package() Get the name of the package to which this meta-class applies. =item $meta->set_accessor( $name ) Set the accessor that is used to retrieve the meta-object from the class to which it applies. =item $meta->add_hash_metric( $metric, %actions ) Add a hash metric (see L). %actions should contain C sub {...}> pairs for constructing actions (See add_action()). =item $meta->add_lists_metric( $metric, %actions ) Add a lists metric (see L) %actions should contain C sub {...}> pairs for constructing actions (See add_action()). =item $meta->add_metric( $metric, \&generator, %actions ) Add a custom metric. The second argument should be a sub that generates a default value for the metric. %actions should contain C sub {...}> pairs for constructing actions (See add_action()). =item $meta->add_action( $metric, $action => sub { ... } ) Add an action for the specified metric. See L for details on how to write an action coderef. =item $meta->hook_before( $metric, $action, sub { ... }) Add a hook for the specified metric. See L for details on how to write a hook coderef. =item $meta->hook_after( $metric, $action, sub { ... }) Add a hook for the specified metric. See L for details on how to write a hook coderef. =back =head1 ACTION AND HOOK METHODS sub { my $self = shift; my ( $data, $metric, $action, @args ) = @_; ...; } Action and hook methods are called when someone calls C<$meta-metric_action(...)>. First all before hooks will be called, the the action itself, and finally the after hooks will be called. All methods in the chain get the exact same unaltered arguments. Only the main action sub can return anything. Arguments are: =over 4 =item 0: $self These are methods, so the first argument is the meta object itself. =item 1: $data This is the data structure stored for the metric. This is the same as calling $meta->metric() =item 2: $metric Name of the metric =item 3: $action Name of the action =item 4+: @args Arguments that metric_action() was called with. =back =head1 DEFAULT ACTION METHODS There are the default action methods used by hashmetrics and listsmetrics. =over 4 =item $meta->default_hash_add( $data, $metric, $action, $item, $value ) =item $value = $meta->default_hash_get( $data, $metric, $action, $item ) =item $bool = $meta->default_hash_has( $data, $metric, $action, $item ) =item $meta->default_hash_clear( $data, $metric, $action, $item ) =item $value = $meta->default_hash_pull( $data, $metric, $action, $item ) =item $meta->default_list_push( $data, $metric, $action, $item, @values ) =item @values = $meta->default_list_get( $data, $metric, $action, $item ) =item $bool = $meta->default_list_has( $data, $metric, $action, $item ) =item $meta->default_list_clear( $data, $metric, $action, $item ) =item @values = $meta->default_list_pull( $data, $metric, $action, $item ) =back =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Meta-Builder is free software; Standard perl licence. Meta-Builder is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Meta-Builder-0.003/lib/Meta/Builder/Util.pm000444003720003720 175211454203725 20747 0ustar00exodistexodist000000000000package Meta::Builder::Util; use strict; use warnings; sub import { my $class = shift; my $caller = caller; inject( $caller, "inject", \&inject ); } sub inject { my ( $class, $sub, $code, $nowarn ) = @_; if ( $nowarn ) { no strict 'refs'; no warnings 'redefine'; *{"$class\::$sub"} = $code; } else { no strict 'refs'; *{"$class\::$sub"} = $code; } } 1; __END__ =head1 NAME Meta::Builder::Util - Utility functions for Meta::Builder =head1 EXPORTS =over 4 =item inject( $class, $name, $code, $redefine ) used to inject a sub into a namespace. =back =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Meta-Builder is free software; Standard perl licence. Meta-Builder is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details.