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 = '2.00';
25             require 5.006;
26              
27 18     18   74 use strict;
  18         27  
  18         374  
28 18     18   73 use warnings;
  18         23  
  18         442  
29              
30 18     18   77 use vars qw( $DEBUG $ERROR $AUTOLOAD $INSTANCE );
  18         31  
  18         3734  
31              
32             $DEBUG = 0 unless defined $DEBUG;
33              
34              
35             #------------------------------------------------------------------------
36             # new($pom)
37             #------------------------------------------------------------------------
38              
39             sub new {
40 1     1 1 10 my $class = shift;
41 1 50       9 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
42 1         5 bless { %$args }, $class;
43             }
44              
45              
46             sub print {
47 10     10 1 21 my ($self, $item) = @_;
48 10 100       49 return UNIVERSAL::can($item, 'present')
49             ? $item->present($self) : $item;
50             }
51            
52              
53             sub view {
54 7     7 1 13 my ($self, $type, $node) = @_;
55 7         22 return $node;
56             }
57              
58              
59             sub instance {
60 8     8 1 10 my $self = shift;
61 8   33     25 my $class = ref $self || $self;
62              
63 18     18   85 no strict 'refs';
  18         27  
  18         8022  
64 8         10 my $instance = \${"$class\::_instance"};
  8         26  
65              
66 8 100       23 defined $$instance
67             ? $$instance
68             : ($$instance = $class->new(@_));
69             }
70              
71              
72             sub visit {
73 3     3 1 16 my ($self, $place) = @_;
74 3 50       12 $self = $self->instance() unless ref $self;
75 3   100     11 my $visit = $self->{ VISIT } ||= [ ];
76 3         5 push(@$visit, $place);
77 3         5 return $place;
78             }
79              
80              
81             sub leave {
82 3     3 1 147 my ($self, $place) = @_;
83 3 50       9 $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         5 pop(@$visit);
87             }
88              
89              
90             sub visiting {
91 2     2 1 11 my ($self, $place) = @_;
92 2 50       13 $self = $self->instance() unless ref $self;
93 2         7 my $visit = $self->{ VISIT };
94 2 100 66     8 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   755 my $self = shift;
105 592         754 my $name = $AUTOLOAD;
106 592         542 my $item;
107              
108 592         1700 $name =~ s/.*:://;
109 592 50       1220 return if $name eq 'DESTROY';
110              
111 592 50       1741 if ($name =~ s/^view_//) {
    0          
112 592         1710 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