File Coverage

lib/Class.pm
Criterion Covered Total %
statement 27 40 67.5
branch 1 8 12.5
condition n/a
subroutine 6 10 60.0
pod n/a
total 34 58 58.6


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Class Objects - ~/lib/Class.pm
3             ## Version v1.1.4
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2022/02/27
7             ## Modified 2022/03/05
8             ## All rights reserved
9             ##
10             ## This program is free software; you can redistribute it and/or modify it
11             ## under the same terms as Perl itself.
12             ##----------------------------------------------------------------------------
13             BEGIN
14             {
15             use strict;
16 2     2   154942 use warnings;
  2         12  
  2         48  
17 2     2   6 use parent qw( Module::Generic );
  2         2  
  2         49  
18 2     2   684 # Faster than 'use constant'. Load time critical.
  2         455  
  2         9  
19             # Must eval to make $] constant.
20             *PERL_VERSION = eval qq{ sub () { $] } };
21 2     2   40426736 our @EXPORT = @Module::Generic::EXPORT;
22 2         7 our @EXPORT_OK = @Module::Generic::EXPORT_OK;
23 2         5 our %EXPORT_TAGS = %Module::Generic::EXPORT_TAGS;
24 2         4 our $VERSION = 'v1.1.4';
25 2         746 };
26              
27             {
28             my $self = shift( @_ );
29             my $pkg = caller;
30 4     4   573 *{$pkg . '::CLASS'} = \$pkg;
31 4         15  
32 4         6 # This logic is compiled out.
  4         14  
33             if( PERL_VERSION >= 5.008 )
34             {
35 4         6 # 5.8.x smart enough to make this a constant.
36             # For legacy, we keep the upper case subroutine as well
37             *{$pkg . '::CLASS'} = sub () { $pkg };
38             }
39 4     9   13 else
  4         9  
  9         120617  
40             {
41             # Make CLASS a constant.
42             *{$pkg . '::CLASS'} = eval qq{ sub () { q{$pkg} } };
43             }
44            
45             local $Exporter::ExportLevel = 1;
46             Exporter::import( $self, @_ );
47 4         7
48 4         48 ( my $dir = $pkg ) =~ s/::/\//g;
49             my $path = $INC{ $dir . '.pm' };
50 4         9 if( defined( $path ) )
51 4         8 {
52 4 50       3391 ## Try absolute path name
53             $path =~ s/^(.*)$dir\.pm$/$1auto\/$dir\/autosplit.ix/;
54             eval
55 0           {
56             local $SIG{ '__DIE__' } = sub{ };
57 0           local $SIG{ '__WARN__' } = sub{ };
58 0     0     require $path;
59 0     0     };
60 0           if( $@ )
61             {
62 0 0         $path = "auto/$dir/autosplit.ix";
63             eval
64 0           {
65             local $SIG{ '__DIE__' } = sub{ };
66 0           local $SIG{ '__WARN__' } = sub{ };
67 0     0     require $path;
68 0     0     };
69 0           }
70             if( $@ )
71             {
72 0 0         CORE::warn( $@ ) unless( $SILENT_AUTOLOAD );
73             }
74 0 0         }
75             }
76              
77             1;
78              
79              
80             =encoding utf8
81              
82             =head1 NAME
83              
84             Class - A Generic Object Class to Inherit From
85              
86             =head1 SYNOPSIS
87              
88             use parent qw( Class );
89            
90             sub init
91             {
92             my $self = shift( @_ );
93             return( $self->SUPER::init( @_ ) );
94             }
95              
96             Support for legacy code:
97              
98             package Foo;
99             use Class;
100              
101             print CLASS; # Foo
102             print "My class is $CLASS\n"; # My class is Foo
103              
104             sub bar { 23 }
105              
106             print CLASS->bar; # 23
107             print $CLASS->bar; # 23
108              
109             =head1 VERSION
110              
111             v1.1.4
112              
113             =head1 DESCRIPTION
114              
115             This package inherits all its features from L<Module::Generic> and provides a generic framework of methods to inherit from and speed up development.
116              
117             It also provides support for legacy code whereby C<CLASS> and C<$CLASS> are both synonyms for C<__PACKAGE__>. Easier to type.
118              
119             C<$CLASS> has the additional benefit of working in strings.
120              
121             C<Class> is a constant, not a subroutine call. C<$CLASS> is a plain variable, it is not tied. There is no performance loss for using C<Class> over C<__PACKAGE__> except the loading of the module. (Thanks Juerd)
122              
123             =head1 SEE ALSO
124              
125             L<Class::Stack>, L<Class::String>, L<Class::Number>, L<Class::Boolean>, L<Class::Assoc>, L<Class::File>, L<Class::DateTime>, L<Class::Exception>, L<Class::Finfo>, L<Class::NullChain>
126              
127             =head1 AUTHOR
128              
129             From February 2022 onward: Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
130              
131             Michael G Schwern E<lt>F<schwern@pobox.com>E<gt>
132              
133             =head1 COPYRIGHT & LICENSE
134              
135             Copyright (c) 2021 DEGUEST Pte. Ltd.
136              
137             You can use, copy, modify and redistribute this package and associated
138             files under the same terms as Perl itself.
139              
140             =cut