File Coverage

blib/lib/Graph/Template/Factory.pm
Criterion Covered Total %
statement 12 45 26.6
branch 2 16 12.5
condition n/a
subroutine 5 8 62.5
pod 0 4 0.0
total 19 73 26.0


line stmt bran cond sub pod time code
1             package Graph::Template::Factory;
2              
3 1     1   6 use strict;
  1         2  
  1         46  
4              
5 1     1   370 BEGIN {
6 1     1   5 use vars qw(%Manifest %isBuildable);
  1         2  
  1         45  
7             }
8              
9             %Manifest = (
10              
11             # These are the instantiable nodes
12             # 'IF' => 'Graph::Template::Container::Conditional',
13             # 'LOOP' => 'Graph::Template::Container::Loop',
14             'DATA' => 'Graph::Template::Container::Data',
15             'GRAPH' => 'Graph::Template::Container::Graph',
16             'SCOPE' => 'Graph::Template::Container::Scope',
17              
18             'DATAPOINT' => 'Graph::Template::Element::DataPoint',
19             'TITLE' => 'Graph::Template::Element::Title',
20             'VAR' => 'Graph::Template::Element::Var',
21             'XLABEL' => 'Graph::Template::Element::XLabel',
22             'YLABEL' => 'Graph::Template::Element::YLabel',
23              
24             # 'FONT' => 'Graph::Template::Container::Font',
25              
26             # These are the helper objects
27              
28             'CONTEXT' => 'Graph::Template::Context',
29             'ITERATOR' => 'Graph::Template::Iterator',
30             'TEXTOBJECT' => 'Graph::Template::TextObject',
31              
32             'CONTAINER' => 'Graph::Template::Container',
33             'ELEMENT' => 'Graph::Template::Element',
34              
35             'BASE' => 'Graph::Template::Base',
36             );
37              
38             while (my ($k, $v) = each %Manifest)
39             {
40             (my $n = $v) =~ s!::!/!g;
41             $n .= '.pm';
42              
43             $Manifest{$k} = {
44             package => $v,
45             filename => $n,
46             };
47             }
48              
49             %isBuildable = map { $_ => undef } qw(
50             DATA
51             DATAPOINT
52             GRAPH
53             SCOPE
54             TITLE
55             VAR
56             XLABEL
57             YLABEL
58             );
59              
60             sub register
61             {
62 0     0 0 0 my %params = @_;
63              
64 0         0 my @param_names = qw(name class isa);
65 0         0 for (@param_names)
66             {
67 0 0       0 unless ($params{$_})
68             {
69 0         0 warn "$_ was not supplied to register()\n";
70 0         0 return 0;
71             }
72             }
73              
74 0         0 my $name = uc $params{name};
75 0 0       0 if (exists $Manifest{$name})
76             {
77 0         0 warn "$params{name} already exists in the manifest.\n";
78 0         0 return 0;
79             }
80              
81 0         0 my $isa = uc $params{isa};
82 0 0       0 unless (exists $Manifest{$isa})
83             {
84 0         0 warn "$params{isa} does not exist in the manifest.\n";
85 0         0 return 0;
86             }
87              
88 0         0 $Manifest{$name} = $params{class};
89 0         0 $isBuildable{$name} = undef;
90              
91             {
92 1     1   6 no strict 'refs';
  1         31  
  1         341  
  0         0  
93 0         0 unshift @{"$params{class}::ISA"}, $Manifest{$isa};
  0         0  
94             }
95              
96 0         0 return 1;
97             }
98              
99             sub create
100             {
101 0     0 0 0 my $class = shift;
102 0         0 my $name = uc shift;
103              
104 0 0       0 return unless exists $Manifest{$name};
105              
106 0         0 eval {
107 0         0 require $Manifest{$name}{filename};
108 0 0       0 }; if ($@) {
109 0         0 print "$@\n";
110 0         0 die "Cannot find PM file for '$name' ($Manifest{$name}{filename})\n";
111             }
112              
113 0         0 return $Manifest{$name}{package}->new(@_);
114             }
115              
116             sub create_node
117             {
118 0     0 0 0 my $class = shift;
119 0         0 my $name = uc shift;
120              
121 0 0       0 return unless exists $isBuildable{$name};
122              
123 0         0 return $class->create($name, @_);
124             }
125              
126             sub isa
127             {
128 1 50   1 0 5 return unless @_ >= 2;
129 1 50       11 exists $Manifest{uc $_[1]}
130             ? UNIVERSAL::isa($_[0], $Manifest{uc $_[1]}{package})
131             : UNIVERSAL::isa(@_)
132             }
133              
134             1;
135             __END__