File Coverage

lib/Class/STL/ClassMembers/FunctionMember.pm
Criterion Covered Total %
statement 38 57 66.6
branch n/a
condition 1 6 16.6
subroutine 9 12 75.0
pod n/a
total 48 75 64.0


line stmt bran cond sub pod time code
1             # vim:ts=4 sw=4
2             # ----------------------------------------------------------------------------------------------------
3             # Name : Class::STL::ClassMembers::FunctionMember.pm
4             # Created : 27 April 2006
5             # Author : Mario Gaffiero (gaffie)
6             #
7             # Copyright 2006-2007 Mario Gaffiero.
8             #
9             # This file is part of Class::STL::Containers(TM).
10             #
11             # Class::STL::Containers is free software; you can redistribute it and/or modify
12             # it under the terms of the GNU General Public License as published by
13             # the Free Software Foundation; version 2 of the License.
14             #
15             # Class::STL::Containers is distributed in the hope that it will be useful,
16             # but WITHOUT ANY WARRANTY; without even the implied warranty of
17             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18             # GNU General Public License for more details.
19             #
20             # You should have received a copy of the GNU General Public License
21             # along with Class::STL::Containers; if not, write to the Free Software
22             # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
23             # ----------------------------------------------------------------------------------------------------
24             # Modification History
25             # When Version Who What
26             # ----------------------------------------------------------------------------------------------------
27             # TO DO:
28             # ----------------------------------------------------------------------------------------------------
29             require 5.005_62;
30 7     7   36 use strict;
  7         13  
  7         176  
31 7     7   33 use warnings;
  7         11  
  7         187  
32 7     7   32 use vars qw($VERSION $BUILD);
  7         12  
  7         1019  
33             $VERSION = '0.18';
34             $BUILD = 'Thursday April 27 23:08:34 GMT 2006';
35             # ----------------------------------------------------------------------------------------------------
36             {
37             package Class::STL::ClassMembers::FunctionMember::Abstract;
38             sub new
39             {
40 0     0   0 my $proto = shift;
41 0   0     0 my $class = ref($proto) || $proto;
42 0         0 my $self = {};
43 0         0 bless($self, $class);
44 0         0 return $self;
45             }
46             sub code
47       0     {
48             # must override
49             }
50             }
51             # ----------------------------------------------------------------------------------------------------
52             {
53             package Class::STL::ClassMembers::FunctionMember::New;
54 7     7   43 use base qw(Class::STL::ClassMembers::FunctionMember::Abstract);
  7         22  
  7         3300  
55             sub code
56             {
57 0     0   0 my $self = shift;
58 0         0 my $tab = ' ' x 4;
59 0         0 my $code = "sub new\n";
60 0         0 $code .= "{\n";
61 0         0 $code .= "${tab}use vars qw(\@ISA);\n";
62 0         0 $code .= "${tab}my \$proto = shift;\n";
63 0         0 $code .= "${tab}my \$class = ref(\$proto) || \$proto;\n";
64 0         0 $code .= "${tab}my \$self = int(\@ISA) ? \$class->SUPER::new(\@_) : {};\n";
65 0         0 $code .= "${tab}bless(\$self, \$class);\n";
66 0         0 $code .= "${tab}\$self->members_init(\@_);\n";
67 0         0 $code .= "${tab}\$self->new_extra(\@_) if (\$self->can('new_extra'));\n";
68 0         0 $code .= "${tab}return \$self;\n";
69 0         0 $code .= "}\n";
70 0         0 return $code;
71             }
72             }
73             # ----------------------------------------------------------------------------------------------------
74             {
75             package Class::STL::ClassMembers::FunctionMember::Disable;
76 7     7   44 use base qw(Class::STL::ClassMembers::FunctionMember::Abstract);
  7         14  
  7         1436  
77 7     7   2685 use Class::STL::ClassMembers qw( function_name );
  7         16  
  7         41  
78 7     7   40 use Carp qw(confess);
  7         10  
  7         1223  
79             sub new
80             {
81 1     1   3 my $proto = shift;
82 1   33     265 my $class = ref($proto) || $proto;
83 1         5 my $self = {};
84 1         2 bless($self, $class);
85 1         27 $self->members_init(function_name => shift);
86 1         5 return $self;
87             }
88             sub code
89             {
90 1     1   1 my $self = shift;
91 1         2 my $caller = shift;
92 1         1 my $tab = ' ' x 4;
93 1         2 my $code;
94 1         2 $code .= "sub @{[ $self->function_name() ]} {\n";
  1         20  
95 1         3 $code .= "${tab}use Carp qw(confess);\n";
96 1         2 $code .= "${tab}confess \"Function '@{[ $self->function_name() ]}' not available for $caller!\";\n";
  1         16  
97 1         2 $code .= "}\n";
98 1         3 return $code;
99             }
100             }
101             # ----------------------------------------------------------------------------------------------------
102             1;