File Coverage

blib/lib/Object/InsideOut/Metadata.pm
Criterion Covered Total %
statement 110 116 94.8
branch 57 72 79.1
condition n/a
subroutine 9 9 100.0
pod 3 4 75.0
total 179 201 89.0


line stmt bran cond sub pod time code
1             package Object::InsideOut::Metadata; {
2              
3 53     53   369 use strict;
  53         115  
  53         1482  
4 53     53   259 use warnings;
  53         101  
  53         5639  
5              
6             our $VERSION = '4.05';
7             $VERSION = eval $VERSION;
8              
9             # Stores method metadata
10             # Initialized with our own metadata
11             my %METADATA = (
12             'Object::InsideOut::Metadata' => {
13             'add_meta' => {'hidden' => 1},
14             'AUTOLOAD' => {'hidden' => 1},
15             'new' => {'hidden' => 1},
16             'create_field' => {'hidden' => 1},
17             'add_class' => {'hidden' => 1},
18             'get_classes' => {'kind' => 'object'},
19             'get_methods' => {'kind' => 'object'},
20             'get_args' => {'kind' => 'object'},
21             },
22             );
23              
24              
25             ### Exported Subroutines ###
26              
27             sub import
28             {
29             # Export 'add_meta' call
30 53     53   369 no strict 'refs';
  53         132  
  53         20988  
31 116     116   331 my $caller = caller();
32 116         428 *{$caller.'::add_meta'} = \&add_meta;
  116         643  
33 116         24372 $METADATA{$caller}{'add_meta'}{'hidden'} = 1;
34             }
35              
36              
37             # Stores metadata for later use
38             sub add_meta
39             {
40 507     507 0 1442 my ($class, $name, $meta, $value) = @_;
41              
42 507 100       1261 if (@_ == 4) {
43 89         300 $METADATA{$class}{$name}{$meta} = $value;
44             } else {
45 418         652 my $data;
46 418 50       1209 if (@_ == 3) {
    100          
47 0         0 $$data{$class}{$name} = $meta;
48             } elsif (@_ == 2) {
49 233         579 $$data{$class} = $name;
50             } else {
51 185         367 $data = $class;
52             }
53 418         1942 while (my ($c, $mn) = each(%$data)) {
54 543         1794 while (my ($n, $md) = each(%$mn)) {
55 3745         10157 while (my ($m, $v) = each(%$md)) {
56 5936         25289 $METADATA{$c}{$n}{$m} = $v;
57             }
58             }
59             }
60             }
61             }
62              
63              
64             # This will load the OO option of our code.
65             # It's done this way because of circular dependencies with OIO.
66             sub AUTOLOAD
67             {
68             # Need 5.8.0 or later
69 2 50   2   43 if ($] < 5.008) {
70 0         0 OIO::Code->die('message' => q/Introspection API requires Perl 5.8.0 or later/,
71             'ignore_package' => 'Object::InsideOut::Metadata');
72             }
73              
74             # It's a bug if not invoked by ->new()
75             # This should only ever happen once
76 2 50       9 if (our $AUTOLOAD ne 'Object::InsideOut::Metadata::new') {
77 0         0 OIO::Method->die('message' => "Object::InsideOut::Metadata does not support AUTOLOAD of $AUTOLOAD",
78             'ignore_package' => 'Object::InsideOut::Metadata');
79             }
80              
81             # Workaround to get %METADATA into our scope
82 2         4 my $meta = \%METADATA;
83              
84             # Load the rest of our code
85 2         6 my $text = do { local $/; };
  2         10  
  2         132  
86 2         26 close(DATA);
87 2 100   12 1 249 eval $text;
  12 100   16 1 8949  
  12 50   18 1 83  
  2 50       13  
  12 50       35  
  12 50       22  
  12 100       39  
  32 100       103  
  32 100       75  
  52 50       104  
  42 0       87  
  42 100       76  
  42 50       127  
  34 100       71  
  34 100       101  
  41 50       100  
  7 100       12  
  23 50       71  
  18 100       104  
  18 50       1823  
  2 100       5  
  18 100       748  
  12 100       23  
  12 100       23  
  12 100       20  
  12 100       35  
  8 100       19  
  8 100       13  
  8 100       24  
  4 100       7  
  12         49  
  4         7  
  8         14  
  0         0  
  12         23  
  8         21  
  12         44  
  10         57  
  14         3696  
  14         59  
  0         0  
  14         25  
  14         35  
  14         37  
  14         59  
  16         14501  
  16         74  
  0         0  
  16         29  
  16         26  
  16         38  
  16         39  
  36         50  
  8         39  
  36         84  
  36         58  
  36         378  
  1645         2445  
  1645         4390  
  1285         3882  
  1203         2351  
  1109         2326  
  1109         1983  
  80         154  
  36         149  
  34         50  
  34         187  
  1063         2071  
  734         1280  
  734         1084  
  36         135  
  2         8  
  16         79  
  327         573  
  325         485  
  325         558  
  245         327  
  245         559  
  310         664  
  16         170  
88 2 50       191 die if $@;
89              
90             # Continue on
91 2         11 goto &Object::InsideOut::new;
92             }
93              
94             } # End of package's lexical scope
95              
96             1;
97              
98             __DATA__