View.pm
Go to the documentation of this file.
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 <abw@kfs.org>
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 BASIS::Pod::POM::View;
24 
25 require 5.004;
26 
27 use strict;
28 use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD $INSTANCE );
29 
30 $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
31 $DEBUG = 0 unless defined $DEBUG;
32 
33 
34 #------------------------------------------------------------------------
35 # new($pom)
36 #------------------------------------------------------------------------
37 
38 sub new {
39  my $class = shift;
40  my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
41  bless { %$args }, $class;
42 }
43 
44 
45 sub print {
46  my ($self, $item) = @_;
47  return UNIVERSAL::can($item, 'present')
48  ? $item->present($self) : $item;
49 }
50 
51 
52 sub view {
53  my ($self, $type, $node) = @_;
54  return $node;
55 }
56 
57 
58 sub instance {
59  my $self = shift;
60  my $class = ref $self || $self;
61 
62  no strict 'refs';
63  my $instance = \${"$class\::_instance"};
64 
65  defined $$instance
66  ? $$instance
67  : ($$instance = $class->new(@_));
68 }
69 
70 
71 sub visit {
72  my ($self, $place) = @_;
73  $self = $self->instance() unless ref $self;
74  my $visit = $self->{ VISIT } ||= [ ];
75  push(@$visit, $place);
76  return $place;
77 }
78 
79 
80 sub leave {
81  my ($self, $place) = @_;
82  $self = $self->instance() unless ref $self;
83  my $visit = $self->{ VISIT };
84  return $self->error('empty VISIT stack') unless @$visit;
85  pop(@$visit);
86 }
87 
88 
89 sub visiting {
90  my ($self, $place) = @_;
91  $self = $self->instance() unless ref $self;
92  my $visit = $self->{ VISIT };
93  return 0 unless $visit && @$visit;
94 
95  foreach (reverse @$visit) {
96  return 1 if $_ eq $place;
97  }
98  return 0;
99 }
100 
101 
102 sub AUTOLOAD {
103  my $self = shift;
104  my $name = $AUTOLOAD;
105  my $item;
106 
107  $name =~ s/.*:://;
108  return if $name eq 'DESTROY';
109 
110  if ($name =~ s/^view_//) {
111  return $self->view($name, @_);
112  }
113  elsif (! ref $self) {
114  die "can't access $name in $self\n";
115  }
116  else {
117  die "no such method for $self: $name ($AUTOLOAD)"
118  unless defined ($item = $self->{ $name });
119 
120  return wantarray ? ( ref $item eq 'ARRAY' ? @$item : $item ) : $item;
121  }
122 }
123 
124 
125 1;
126 
127 =head1 NAME
128 
129 Pod::POM::View
130 
131 =head1 DESCRIPTION
132 
133 Visitor class for creating a view of all or part of a Pod Object Model.
134 
135 =head1 METHODS
136 
137 =over 4
138 
139 =item C<new>
140 
141 =item C<print>
142 
143 =item C<view>
144 
145 =item C<instance>
146 
147 =item C<visit>
148 
149 =item C<leave>
150 
151 =item C<visiting>
152 
153 =back
154 
155 =head1 AUTHOR
156 
157 Andy Wardley E<lt>abw@kfs.orgE<gt>
158 
159 =head1 COPYRIGHT AND LICENSE
160 
161 Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved.
162 
163 This module is free software; you can redistribute it and/or
164 modify it under the same terms as Perl itself.
165 
166 =cut