View.pm
Go to the documentation of this file.
00001 #============================================================= -*-Perl-*- 00002 # 00003 # Pod::POM::View 00004 # 00005 # DESCRIPTION 00006 # Visitor class for creating a view of all or part of a Pod Object 00007 # Model. 00008 # 00009 # AUTHOR 00010 # Andy Wardley <abw@kfs.org> 00011 # 00012 # COPYRIGHT 00013 # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. 00014 # 00015 # This module is free software; you can redistribute it and/or 00016 # modify it under the same terms as Perl itself. 00017 # 00018 # REVISION 00019 # $Id: View.pm 32 2009-03-17 21:08:25Z ford $ 00020 # 00021 #======================================================================== 00022 00023 package BASIS::Pod::POM::View; 00024 00025 require 5.004; 00026 00027 use strict; 00028 use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD $INSTANCE ); 00029 00030 $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/); 00031 $DEBUG = 0 unless defined $DEBUG; 00032 00033 00034 #------------------------------------------------------------------------ 00035 # new($pom) 00036 #------------------------------------------------------------------------ 00037 00038 sub new { 00039 my $class = shift; 00040 my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; 00041 bless { %$args }, $class; 00042 } 00043 00044 00045 sub print { 00046 my ($self, $item) = @_; 00047 return UNIVERSAL::can($item, 'present') 00048 ? $item->present($self) : $item; 00049 } 00050 00051 00052 sub view { 00053 my ($self, $type, $node) = @_; 00054 return $node; 00055 } 00056 00057 00058 sub instance { 00059 my $self = shift; 00060 my $class = ref $self || $self; 00061 00062 no strict 'refs'; 00063 my $instance = \${"$class\::_instance"}; 00064 00065 defined $$instance 00066 ? $$instance 00067 : ($$instance = $class->new(@_)); 00068 } 00069 00070 00071 sub visit { 00072 my ($self, $place) = @_; 00073 $self = $self->instance() unless ref $self; 00074 my $visit = $self->{ VISIT } ||= [ ]; 00075 push(@$visit, $place); 00076 return $place; 00077 } 00078 00079 00080 sub leave { 00081 my ($self, $place) = @_; 00082 $self = $self->instance() unless ref $self; 00083 my $visit = $self->{ VISIT }; 00084 return $self->error('empty VISIT stack') unless @$visit; 00085 pop(@$visit); 00086 } 00087 00088 00089 sub visiting { 00090 my ($self, $place) = @_; 00091 $self = $self->instance() unless ref $self; 00092 my $visit = $self->{ VISIT }; 00093 return 0 unless $visit && @$visit; 00094 00095 foreach (reverse @$visit) { 00096 return 1 if $_ eq $place; 00097 } 00098 return 0; 00099 } 00100 00101 00102 sub AUTOLOAD { 00103 my $self = shift; 00104 my $name = $AUTOLOAD; 00105 my $item; 00106 00107 $name =~ s/.*:://; 00108 return if $name eq 'DESTROY'; 00109 00110 if ($name =~ s/^view_//) { 00111 return $self->view($name, @_); 00112 } 00113 elsif (! ref $self) { 00114 die "can't access $name in $self\n"; 00115 } 00116 else { 00117 die "no such method for $self: $name ($AUTOLOAD)" 00118 unless defined ($item = $self->{ $name }); 00119 00120 return wantarray ? ( ref $item eq 'ARRAY' ? @$item : $item ) : $item; 00121 } 00122 } 00123 00124 00125 1; 00126 00127 =head1 NAME 00128 00129 Pod::POM::View 00130 00131 =head1 DESCRIPTION 00132 00133 Visitor class for creating a view of all or part of a Pod Object Model. 00134 00135 =head1 METHODS 00136 00137 =over 4 00138 00139 =item C<new> 00140 00141 =item C<print> 00142 00143 =item C<view> 00144 00145 =item C<instance> 00146 00147 =item C<visit> 00148 00149 =item C<leave> 00150 00151 =item C<visiting> 00152 00153 =back 00154 00155 =head1 AUTHOR 00156 00157 Andy Wardley E<lt>abw@kfs.orgE<gt> 00158 00159 =head1 COPYRIGHT AND LICENSE 00160 00161 Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. 00162 00163 This module is free software; you can redistribute it and/or 00164 modify it under the same terms as Perl itself. 00165 00166 =cut