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   176 use strict;
  53         696  
  53         2505  
4 53     53   152 use warnings;
  53         52  
  53         4085  
5              
6             our $VERSION = '4.03';
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   182 no strict 'refs';
  53         773  
  53         18378  
31 116     116   1591 my $caller = caller();
32 116         155 *{$caller.'::add_meta'} = \&add_meta;
  116         515  
33 116         5732 $METADATA{$caller}{'add_meta'}{'hidden'} = 1;
34             }
35              
36              
37             # Stores metadata for later use
38             sub add_meta
39             {
40 507     507 0 703 my ($class, $name, $meta, $value) = @_;
41              
42 507 100       849 if (@_ == 4) {
43 89         224 $METADATA{$class}{$name}{$meta} = $value;
44             } else {
45 418         340 my $data;
46 418 50       862 if (@_ == 3) {
    100          
47 0         0 $$data{$class}{$name} = $meta;
48             } elsif (@_ == 2) {
49 233         388 $$data{$class} = $name;
50             } else {
51 185         207 $data = $class;
52             }
53 418         1368 while (my ($c, $mn) = each(%$data)) {
54 543         1556 while (my ($n, $md) = each(%$mn)) {
55 3745         6089 while (my ($m, $v) = each(%$md)) {
56 5936         17716 $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   7 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       5 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         2 my $text = do { local $/; };
  2         10  
  2         99  
86 2         16 close(DATA);
87 2 100   12 1 152 eval $text;
  12 100   16 1 4540  
  12 50   18 1 80  
  2 50       10  
  12 50       18  
  12 50       12  
  12 100       26  
  32 100       47  
  32 100       41  
  52 50       77  
  42 0       52  
  42 100       45  
  42 50       56  
  34 100       38  
  34 100       50  
  41 50       73  
  7 100       7  
  23 50       39  
  18 100       83  
  18 50       1207  
  2 100       3  
  18 100       569  
  12 100       15  
  12 100       11  
  12 100       9  
  12 100       24  
  8 100       8  
  8 100       10  
  8 100       18  
  4 100       4  
  12         33  
  4         3  
  8         7  
  0         0  
  12         14  
  8         11  
  12         22  
  10         39  
  14         2336  
  14         43  
  0         0  
  14         13  
  14         18  
  14         22  
  14         41  
  16         8751  
  16         52  
  0         0  
  16         12  
  16         14  
  16         24  
  16         20  
  36         32  
  8         14  
  36         41  
  36         32  
  36         252  
  1629         872  
  1629         2880  
  1285         1689  
  1203         1427  
  1109         1222  
  1109         1207  
  80         70  
  36         101  
  34         28  
  34         131  
  1063         1350  
  734         513  
  734         479  
  36         93  
  2         5  
  16         48  
  327         371  
  325         219  
  325         361  
  245         145  
  245         310  
  310         393  
  16         115  
88 2 50       127 die if $@;
89              
90             # Continue on
91 2         6 goto &Object::InsideOut::new;
92             }
93              
94             } # End of package's lexical scope
95              
96             1;
97              
98             __DATA__