File Coverage

blib/lib/Perl6/Pod/Utl/AbstractVisiter.pm
Criterion Covered Total %
statement 31 48 64.5
branch 5 12 41.6
condition 3 12 25.0
subroutine 7 10 70.0
pod 0 3 0.0
total 46 85 54.1


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # DESCRIPTION: Abstract Class for Nodes Visiter
4             #
5             # AUTHOR: Aliaksandr P. Zahatski,
6             #===============================================================================
7             package Perl6::Pod::Utl::AbstractVisiter;
8 4     4   591 use strict;
  4         8  
  4         117  
9 4     4   26 use warnings;
  4         9  
  4         160  
10 4     4   56 use vars qw($AUTOLOAD);
  4         61  
  4         343  
11 4     4   22 use Carp;
  4         26  
  4         2777  
12             our $VERSION = '0.01';
13              
14             sub new {
15 0     0 0 0 my $class = shift;
16 0 0 0     0 my $self = bless( $#_ == 0 ? shift : {@_}, ref($class) || $class );
17 0         0 $self;
18             }
19              
20             sub visit {
21 28     28 0 242 my $self = shift;
22 28         36 my $n = shift;
23              
24             #get type of file
25 28         48 my $ref = ref($n);
26 28 100 66     174 unless ( ref($n) && UNIVERSAL::isa( $n, 'Perl6::Pod::Lex::Block' )
27             )
28             {
29 13 50       33 if ( ref($n) eq 'ARRAY' ) {
30 13         42 $self->visit($_) for @$n;
31             }
32             else {
33 0         0 die "Unknown node type $n (not isa Perl6::Pod::Lex::Block)";
34             }
35             }
36              
37 28         267 my $method = $self->__get_method_name($n);
38             #make method name
39 28         143 $self->$method($n);
40             }
41              
42             =head2 __get_method_name $ref
43              
44             make mathod name from object ref
45              
46             =cut
47             sub __get_method_name {
48 28     28   37 my $self = shift;
49 28   33     78 my $el = shift || croak "wait object !";
50 28         53 my $method = ref($el);
51 28         88 $method =~ s/.*:://;
52 28         68 return $method;
53             }
54              
55             sub visit_childs {
56 0     0 0 0 my $self = shift;
57 0         0 foreach my $n (@_) {
58 0 0 0     0 die "Unknow type $n (not isa Perl6::Pod::Block)"
59             unless UNIVERSAL::isa( $n, 'Perl6::Pod::Block' ) ||
60             UNIVERSAL::isa( $n, 'Perl6::Pod::Lex::Block' );
61 0         0 foreach my $ch ( @{ $n->childs } ) {
  0         0  
62 0         0 $self->visit($ch);
63             }
64             }
65             }
66              
67             sub __default_method {
68 0     0   0 my $self =shift;
69 0         0 my $n = shift;
70 0         0 my $method = ref($n);
71 0         0 $method =~ s/.*:://;
72 0         0 die ref($self) . ": Method '$method' for class " . ref($n) . " not implemented at ";
73             }
74              
75             sub AUTOLOAD {
76 30     30   46 my $self = shift;
77 30         55 my $method = $AUTOLOAD;
78 30         106 $method =~ s/.*:://;
79 30 50       84 return if $method eq 'DESTROY';
80              
81             #check if can
82 30 50       102 if ( $self->can($method) ) {
83 0         0 my $superior = "SUPER::$method";
84 0         0 $self->$superior(@_);
85             }
86             else {
87 30         99 $self->__default_method(@_);
88             }
89             }
90              
91             1;
92