Pipeline::Dumper - tool for dumping a pipeline


Pipeline documentation Contained in the Pipeline distribution.

Index


Code Index:

NAME

Top

Pipeline::Dumper - tool for dumping a pipeline

SYNOPSIS

Top

  my $pipeline = Pipeline->new();
  my $dumper   = Pipeline::Dumper->new();
  $pipeline->dispatcher( $dumper );
  $pipeline->dispatch();

DESCRIPTION

Top

Pipeline::Dumper is a subclassed dispatcher. It will simply dump the structure of a pipeline to STDOUT instead of actively executing the pipeline.

AUTHOR

Top

James A. Duncan <jduncan@fotango.com>

COPYRIGHT

Top


Pipeline documentation Contained in the Pipeline distribution.

package Pipeline::Dumper;

use strict;
use warnings;

use Pipeline::Dispatch;
use base qw( Pipeline::Dispatch );

our $VERSION = "3.12";

sub init {
  my $self = shift;
  if ($self->SUPER::init( @_ )) {
    $self->{ indent } = 0;
    return $self;
  }
}

sub dispatch_a_segment {
  my $self = shift;
  my $seg  = shift;
  if ($seg->isa('Pipeline')) {
    $self->next_pipeline( $seg );
  } else {
    $self->next_segment( $seg );
  }
  return 1;
}

sub next_pipeline {
  my $self = shift;
  my $seg  = shift;
  my $pipe = $seg->parent();
  $self->indent;
  $self->print($seg);
  $self->indent;

  ## this sets up the dispatcher in the next pipeline
  $seg->dispatcher(
		   ref($self)->new()
		             ->indent( $self->indent_val )
		             ->segments(
					$seg->dispatcher
					    ->segments
				       )
		  );
  $seg->dispatch();
  $self->undent;
  $self->undent;
}

sub next_segment {
  my $self = shift;
  my $seg  = shift;
  my $pipe = $seg->parent();
  $self->print($seg);
}

sub print {
  my $self = shift;
  my $seg  = shift;
  print "   " x $self->indent_val();
  if ($seg->isa('Pipeline')) { print "> " }
  else { print "| " }
  print ref($seg);
  print "\n";
}

sub indent {
  my $self = shift;
  my $val  = shift;
  if (defined( $val )) {
    $self->{ indent } = $val;
    return $self;
  } else {
    $self->{ indent }++;
  }
}

sub undent {
  my $self = shift;
  $self->{ indent }--;
}

sub indent_val {
  my $self = shift;
  return $self->{ indent };
}


1;

__END__