File Coverage

blib/lib/Class/OOorNO.pm
Criterion Covered Total %
statement 10 35 28.5
branch 0 16 0.0
condition 0 5 0.0
subroutine 4 9 44.4
pod 5 6 83.3
total 19 71 26.7


line stmt bran cond sub pod time code
1             package Class::OOorNO;
2 5     5   36379 use strict;
  5         11  
  5         240  
3 5     5   27 use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS );
  5         11  
  5         511  
4 5     5   27 use Exporter;
  5         13  
  5         3030  
5             $VERSION = 0.01_1; # 2/30/02, 1:50 am
6             @ISA = qw( Exporter );
7             @EXPORT_OK = qw( OOorNO myargs myself coerce_array shave_opts );
8             %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
9              
10             # --------------------------------------------------------
11             # Constructor
12             # --------------------------------------------------------
13 3     3 0 52 sub new { bless({ }, shift(@_)) }
14              
15              
16             # --------------------------------------------------------
17             # Class::OOorNO::Class::OOorNO()
18             # --------------------------------------------------------
19 0 0   0 1   sub OOorNO { return($_[0]) if UNIVERSAL::isa($_[0],'UNIVERSAL') }
20              
21              
22             # --------------------------------------------------------
23             # Class::OOorNO::myargs()
24             # --------------------------------------------------------
25 0 0   0 1   sub myargs { shift(@_) if UNIVERSAL::isa($_[0], (caller(0))[0]); @_ }
  0            
26              
27              
28             # --------------------------------------------------------
29             # Class::OOorNO::myself()
30             # --------------------------------------------------------
31 0 0   0 1   sub myself { UNIVERSAL::isa($_[0], (caller(0))[0]) ? $_[0] : undef }
32              
33              
34             # --------------------------------------------------------
35             # Class::OOorNO::shave_opts()
36             # --------------------------------------------------------
37             sub shave_opts {
38              
39 0     0 1   my($mamma) = myargs(@_);
40              
41 0 0         return undef unless UNIVERSAL::isa($mamma,'ARRAY');
42              
43 0           my(@maid) = @$mamma; @$mamma = ();
  0            
44 0           my($opts) = {};
45              
46 0           while (@maid) {
47              
48 0   0       my($o) = shift(@maid)||'';
49              
50 0 0         if (substr($o,0,2) eq '--') {
51              
52 0   0       $opts->{[split(/=/o,$o)]->[0]} = [split(/=/o,$o)]->[1] || $o;
53             }
54             else {
55              
56 0           push(@$mamma, $o);
57             }
58             }
59              
60 0           return($opts);
61             }
62              
63              
64             # --------------------------------------------------------
65             # Class::OOorNO::coerce_array()
66             # --------------------------------------------------------
67             sub coerce_array {
68              
69 0     0 1   my($hashref) = {};
70 0           my($i) = 0;
71 0           my(@shadow) = myargs(@_);
72              
73 0           while (@shadow) {
74              
75 0           my($name,$val) = splice(@shadow,0,2);
76              
77 0 0         if (defined($name)) {
78              
79 0 0         $hashref->{$name} = (defined($val)) ? $val : '';
80             }
81             else {
82              
83 0           ++$i;
84              
85 0 0         $hashref->{qq[un-named key no. $i]} = (defined($val)) ? $val : '';
86             }
87             }
88              
89 0           return($hashref);
90             }
91              
92             1;
93