File Coverage

blib/lib/Pod/POM/View.pm
Criterion Covered Total %
statement 47 51 92.1
branch 14 30 46.6
condition 5 8 62.5
subroutine 12 12 100.0
pod 7 7 100.0
total 85 108 78.7


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Pod::POM::View
4             #
5             # DESCRIPTION
6             # Visitor class for creating a view of all or part of a Pod Object
7             # Model.
8             #
9             # AUTHOR
10             # Andy Wardley
11             #
12             # COPYRIGHT
13             # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved.
14             #
15             # This module is free software; you can redistribute it and/or
16             # modify it under the same terms as Perl itself.
17             #
18             # REVISION
19             # $Id: View.pm 32 2009-03-17 21:08:25Z ford $
20             #
21             #========================================================================
22              
23             package Pod::POM::View;
24             $Pod::POM::View::VERSION = '0.30';
25             require 5.006;
26              
27 18     18   73 use strict;
  18         25  
  18         376  
28 18     18   71 use warnings;
  18         25  
  18         463  
29              
30 18     18   81 use vars qw( $DEBUG $ERROR $AUTOLOAD $INSTANCE );
  18         28  
  18         3849  
31              
32             $DEBUG = 0 unless defined $DEBUG;
33              
34              
35             #------------------------------------------------------------------------
36             # new($pom)
37             #------------------------------------------------------------------------
38              
39             sub new {
40 1     1 1 19 my $class = shift;
41 1 50       4 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
42 1         4 bless { %$args }, $class;
43             }
44              
45              
46             sub print {
47 10     10 1 27 my ($self, $item) = @_;
48 10 100       47 return UNIVERSAL::can($item, 'present')
49             ? $item->present($self) : $item;
50             }
51            
52              
53             sub view {
54 7     7 1 11 my ($self, $type, $node) = @_;
55 7         26 return $node;
56             }
57              
58              
59             sub instance {
60 8     8 1 12 my $self = shift;
61 8   33     23 my $class = ref $self || $self;
62              
63 18     18   80 no strict 'refs';
  18         33  
  18         8403  
64 8         8 my $instance = \${"$class\::_instance"};
  8         34  
65              
66 8 100       24 defined $$instance
67             ? $$instance
68             : ($$instance = $class->new(@_));
69             }
70              
71              
72             sub visit {
73 3     3 1 20 my ($self, $place) = @_;
74 3 50       9 $self = $self->instance() unless ref $self;
75 3   100     11 my $visit = $self->{ VISIT } ||= [ ];
76 3         4 push(@$visit, $place);
77 3         4 return $place;
78             }
79              
80              
81             sub leave {
82 3     3 1 147 my ($self, $place) = @_;
83 3 50       11 $self = $self->instance() unless ref $self;
84 3         4 my $visit = $self->{ VISIT };
85 3 50       7 return $self->error('empty VISIT stack') unless @$visit;
86 3         4 pop(@$visit);
87             }
88              
89              
90             sub visiting {
91 2     2 1 11 my ($self, $place) = @_;
92 2 50       14 $self = $self->instance() unless ref $self;
93 2         6 my $visit = $self->{ VISIT };
94 2 100 66     9 return 0 unless $visit && @$visit;
95              
96 1         8 foreach (reverse @$visit) {
97 1 50       5 return 1 if $_ eq $place;
98             }
99 0         0 return 0;
100             }
101            
102              
103             sub AUTOLOAD {
104 592     592   693 my $self = shift;
105 592         701 my $name = $AUTOLOAD;
106 592         558 my $item;
107              
108 592         1745 $name =~ s/.*:://;
109 592 50       1220 return if $name eq 'DESTROY';
110              
111 592 50       1581 if ($name =~ s/^view_//) {
    0          
112 592         1676 return $self->view($name, @_);
113             }
114             elsif (! ref $self) {
115 0           die "can't access $name in $self\n";
116             }
117             else {
118             die "no such method for $self: $name ($AUTOLOAD)"
119 0 0         unless defined ($item = $self->{ $name });
120              
121 0 0         return wantarray ? ( ref $item eq 'ARRAY' ? @$item : $item ) : $item;
    0          
122             }
123             }
124              
125              
126             1;
127              
128             =head1 NAME
129              
130             Pod::POM::View
131              
132             =head1 DESCRIPTION
133              
134             Visitor class for creating a view of all or part of a Pod Object Model.
135              
136             =head1 METHODS
137              
138             =over 4
139              
140             =item C
141              
142             =item C
143              
144             =item C
145              
146             =item C
147              
148             =item C
149              
150             =item C
151              
152             =item C
153              
154             =back
155              
156             =head1 AUTHOR
157              
158             Andy Wardley Eabw@kfs.orgE
159              
160             =head1 COPYRIGHT AND LICENSE
161              
162             Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved.
163              
164             This module is free software; you can redistribute it and/or
165             modify it under the same terms as Perl itself.
166              
167             =cut