File Coverage

blib/lib/Class/PObject/Type.pm
Criterion Covered Total %
statement 44 55 80.0
branch 10 22 45.4
condition 2 6 33.3
subroutine 13 15 86.6
pod 5 9 55.5
total 74 107 69.1


line stmt bran cond sub pod time code
1             package Class::PObject::Type;
2              
3             # $Id: Type.pm,v 1.6 2004/05/19 06:07:52 sherzodr Exp $
4              
5 6     6   24 use strict;
  6         10  
  6         189  
6             #use diagnostics;
7 6     6   25 use vars ('$VERSION', '@ISA');
  6         7  
  6         504  
8             use overload (
9             '""' => 'id',
10 0 0   0   0 bool => sub { shift->{id} ? 1 : 0 },
11 6         54 fallback => 1
12 6     6   30 );
  6         8  
13 6     6   568 use Carp;
  6         8  
  6         3390  
14              
15              
16             $VERSION = '1.03';
17              
18              
19              
20              
21              
22              
23              
24              
25              
26             # meant to be overwritten
27             sub _init {
28 36     36   48 my $self = shift;
29              
30             }
31              
32              
33              
34              
35              
36              
37              
38              
39             sub new {
40 39     39 0 53 my $class = shift;
41 39   33     167 $class = ref($class) || $class;
42              
43 39         100 my $self = { @_ };
44              
45 39         63 bless $self, $class;
46 39         131 $self->_init();
47 39         139 return $self
48             }
49              
50              
51              
52             sub id {
53 179     179 0 178 my $self = shift;
54             return $self->{id}
55 179         1841 }
56              
57              
58              
59              
60             sub load {
61 81     81 0 80 my $class = shift;
62 81   33     256 $class = ref($class) || $class;
63 81         339 return bless { id=>$_[0], args=>$_[1] }, $class
64             }
65              
66              
67              
68              
69             sub dump {
70 0     0 0 0 my $self = shift;
71              
72 0         0 require Data::Dumper;
73 0         0 my $d = Data::Dumper->new([$self], [ref $self]);
74 0         0 $d->Indent(2);
75 0         0 return $d->Dump()
76             }
77              
78              
79              
80              
81             # member functions for each column type
82             sub substr {
83 1     1 1 3 my $self = shift;
84 1 50       4 unless ( @_ ) {
85 0         0 croak "$self->substr(): usage error";
86             }
87 1 50       4 return unless defined $self->id();
88 1         4 return CORE::substr($self->id, $_[0], $_[1])
89             }
90              
91              
92              
93             sub ucfirst {
94 1     1 1 3 my $self = shift;
95              
96 1 50       4 if ( @_ ) {
97 0         0 croak "$self->ucfirst(): usage error";
98             }
99 1 50       4 return unless defined $self->id();
100 1         4 return CORE::ucfirst( $self->id );
101             }
102              
103              
104              
105             sub lcfirst {
106 1     1 1 3 my $self = shift;
107              
108 1 50       6 if ( @_ ) {
109 0         0 croak "$self->lcfirst(): usage error";
110             }
111 1 50       4 return unless defined $self->id();
112 1         4 return CORE::lcfirst( $self->id );
113             }
114              
115              
116              
117             sub lc {
118 1     1 1 3 my $self = shift;
119              
120 1 50       5 if ( @_ ) {
121 0         0 croak "$self->lc(): usage error";
122             }
123 1 50       4 return unless defined $self->id();
124 1         4 return CORE::lc( $self->id );
125             }
126              
127              
128              
129             sub uc {
130 1     1 1 3 my $self = shift;
131              
132 1 50       4 if ( @_ ) {
133 0         0 croak "$self->uc(): usage error";
134             }
135 1 50       4 return unless defined $self->id();
136 1         5 return CORE::uc( $self->id );
137             }
138              
139              
140              
141             1;
142             __END__