File Coverage

blib/lib/Class/Visitor.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

#
# Copyright (C) 1997 Ken MacLeod
# Class::Visitor is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# $Id: Visitor.pm,v 1.3 1997/11/03 17:38:10 ken Exp $
#

package Class::Visitor;

require 5.000;
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(visitor_class);
use strict;
use vars qw($VERSION);

$VERSION = '0.02';

use Class::Template;
use Class::Iter;

sub visitor_class {
    my( $pkg, $super, $ref ) = @_;
    my @methods = ();
    my %refs = ();
    my %arrays = ();
    my %hashes = ();
    my $out = '';

    members ($pkg, $ref);

    # XXX this is redundant, but saves hacking Class::Template
    Class::Template::parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes );

    eval "\@${pkg}::ISA = qw{$super}";
    if ($super eq 'Class::Visitor::Base') {
	eval "\@${pkg}::Iter::ISA = qw{Class::Iter}";
    } else {
	eval "\@${pkg}::Iter::ISA = qw{${super}::Iter}";
    }

    $out = <
{
  package $pkg;
EOF
    build_push_methods_( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes );


    my $str = <<'EOF';
  sub accept {
    my $self = shift; my $visitor = shift;
    $visitor->visit_!visit_method! ($self, @_);
  }
  # [self, parent, array, index]
  sub iter {
    my $iter = [@_];
    bless $iter, '!package!::Iter';
  }

  sub new {
    my ($type) = shift;

    my ($self) = !type!;
    bless ($self, $type);

    return ($self);
  }
}

{
  package !package!::Iter;

  sub accept {
    my $self = shift; my $visitor = shift;
    $visitor->visit_!visit_method! ($self, @_);
  }
EOF
        my $visit_method = $pkg;
        $visit_method =~ s/::/_/g;
        $str =~ s/!package!/$pkg/g;
        $str =~ s/!visit_method!/$visit_method/g;
        my $type = (ref ($ref) eq 'HASH') ? '{@_}' : '[@_]';
        $str =~ s/!type!/$type/g;
        $out .= $str;

        build_iter_methods_( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes );

    $out .= "}\n1;\n";

    # XXX we ``inherit'' `print' from Class::Template
    ( $Class::Template::print ) ? print( $out ) : eval $out;
}

sub build_iter_methods_ {
    my( $ref, $out, $methods, $refs, $arrays, $hashes ) = @_;
    my $type = ref $ref;

    my $method;
    foreach $method (@$methods) {
	$$out .= <
  sub $method {
    my \$self = shift;
    return (\$self->[0]->$method (\@_));
  }
EOF
	if (defined $arrays->{$method}) {
	    if ($method eq 'contents') {
		$$out .= <
  sub children_accept {
      children_accept_contents (\@_);
  }
  sub as_string {
      contents_as_string (\@_);
  }
EOF
	    }
	    my $str = <<'EOF';
  sub push_!member! {
      my $self = shift;
      return ($self->[0]->push_!member! (@_));
  }
  sub pop_!member! {
      my $self = shift;
      return ($self->[0]->pop_!member! (@_));
  }
  sub !member!_as_string {
      my $self = shift;
      return ($self->[0]->!member!_as_string (@_));
  }
  sub children_accept_!member! {
    my $self = shift; my $visitor = shift;
    my $array = $self->[0]->!member!();
    my $ii;
    for ($ii = 0; $ii <= $#$array; $ii ++) {
	my ($child) = $array->[$ii];
	if (!ref ($child)) {
	    my $iter = bless ([$child, $self, $array, $ii],
			      'Class::Scalar::Iter');
	    $visitor->visit_scalar ($iter, @_);
	} else {
	    my $iter = $child->iter ($self, $array, $ii);
	    $iter->accept ($visitor, @_);
	}
    }
  }
EOF
            $str =~ s/!member!/$method/g;
            $$out .= $str;
        }
    }
}

sub build_push_methods_ {
    my( $ref, $out, $methods, $refs, $arrays, $hashes ) = @_;
    my $type = ref $ref;

    my $method;
    my $cnt = 0;		# count used for array classes
    foreach $method (@$methods) {
	if (defined $arrays->{$method}) {
	    if ($method eq 'contents') {
		$$out .= <
  sub push {
      return (push_contents (\@_));
  }
  sub pop {
      return (pop_contents (\@_));
  }
  sub as_string {
      return (contents_as_string (\@_));
  }
  sub children_accept {
      return (children_accept_contents (\@_));
  }
EOF
	    }
            my $str = <<'EOF';
  sub push_!member! {
      my $self = shift;
      push (@{$self->!member_ref!}, @_);
  }
  sub pop_!member! {
      my $self = shift;
      return (pop (@{$self->!member_ref!}));
  }
  sub !member!_as_string {
      my $self = shift;
      my $array = $self->!member_ref!;
      my @string;
      my $ii;
      for ($ii = 0; $ii <= $#$array; $ii ++) {
	  my ($child) = $array->[$ii];
	  if (!ref ($child)) {
	      # XXX should use context for a CDATA mapper
	      push (@string, $child);
	} else {
	    # note, not passing as iterator
	    push (@string, $child->as_string(@_));
	}
    }
    return (join ("", @string));
  }
  sub children_accept_!member! {
    my $self = shift; my $visitor = shift;
    my $array = $self->!member_ref!;
    my $ii;
    for ($ii = 0; $ii <= $#$array; $ii ++) {
	my ($child) = $array->[$ii];
	if (!ref ($child)) {
	    $visitor->visit_scalar ($child, @_);
	} else {
	    $child->accept ($visitor, @_);
	}
    }
  }
EOF
            $str =~ s/!member!/$method/g;
            my $member_ref = ($type eq 'HASH') ? "{'$method'}" : "[$cnt]";
            $str =~ s/!member_ref!/$member_ref/g;
            $$out .= $str;
        }

        $cnt ++;
    }
}

package Class::Visitor::Base;

sub is_iter {
    return 0;
}

sub delegate {
    return $_[0];
}

1;
__END__