File Coverage

blib/lib/DBICx/Modeler/Model.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package DBICx::Modeler::Model;
2              
3 1     1   99584 use strict;
  1         2  
  1         38  
4 1     1   5 use warnings;
  1         3  
  1         29  
5              
6 1     1   826 use DBICx::Modeler::Carp;
  1         3  
  1         8  
7 1     1   354 use constant TRACE => DBICx::Modeler::Carp::TRACE;
  1         14  
  1         48  
8              
9 1     1   8711 use Moose();
  0            
  0            
10             use Moose::Exporter;
11              
12             use DBICx::Modeler::Model::Meta;
13              
14             {
15              
16             my ($import, $unimport) = Moose::Exporter->build_import_methods(
17             with_caller => [qw/
18             after before around
19             belongs_to has_one has_many might_have
20             /],
21             also => [ qw/Moose/ ],
22             );
23              
24             sub import {
25             my $class = caller();
26              
27             return if $class eq 'main';
28              
29             my $meta = Moose::Meta::Class->initialize( $class );
30             my $model_meta = DBICx::Modeler::Model::Meta->new( model_class => $class );
31             $meta->add_method( _model__meta => sub {
32             return $model_meta;
33             } );
34             Moose::Util::apply_all_roles( $meta => qw/DBICx::Modeler::Does::Model/ );
35              
36             goto &$import;
37             }
38              
39             *unimport = \&$unimport;
40             *unimport = $unimport; # Derp, derp, derp, warning
41             }
42              
43             sub after {
44             my $caller = shift;
45             push @{ $caller->_model__meta->_specialization->{method_modifier} }, [ after => @_ ];
46             }
47              
48             sub before {
49             my $caller = shift;
50             push @{ $caller->_model__meta->_specialization->{method_modifier} }, [ before => @_ ];
51             }
52              
53             sub around {
54             my $caller = shift;
55             push @{ $caller->_model__meta->_specialization->{method_modifier} }, [ around => @_ ];
56             }
57              
58             sub belongs_to {
59             my ($caller, $relationship_name, $model_class) = @_;
60             $caller->_model__meta->belongs_to( $relationship_name => $model_class );
61             }
62              
63             sub has_one {
64             my ($caller, $relationship_name, $model_class) = @_;
65             $caller->_model__meta->has_one( $relationship_name => $model_class );
66             }
67              
68             sub has_many {
69             my ($caller, $relationship_name, $model_class) = @_;
70             $caller->_model__meta->has_many( $relationship_name => $model_class );
71             }
72              
73             sub might_have {
74             my ($caller, $relationship_name, $model_class) = @_;
75             $caller->_model__meta->might_have( $relationship_name => $model_class );
76             }
77              
78             1;