#======================================================================
#
# Text::ProcessMap
#
# Perl module which displays Activity Diagrams in plain text format.
#
# Copyright 2005, Brad J. Adkins. All rights reserved.
#
# This library is free software; you can redistribute it and/or modify 
# it under the same terms as Perl itself.
#
# Address bug reports and comments to: <bradjadkins@badkins.net>.
#
#======================================================================

package Text::ProcessMap;

use strict;
use Carp;
use File::Spec;

our $VERSION = '0.01';

{
  my %_attrs = (
    _title       => 'header',
    _description => 'header',
    _topnote     => 'header',
    _diagramnote => 'header',
    _name        => 'header',
    _number      => 'header',
    _loader_file => 'header',
    _output_file => 'header',
    _minwidth    => 'header',
    _test        => 'header',
    _layout      => 'body',
    _coltitles   => 'body',
    _colwidths   => 'body',
    _boxchars    => 'body',
    _colsp       => 'body'
  );

  sub _accessible {
    my ($self, $property, $method) = @_;

    $property = '_' . $property;
    if ( exists $_attrs{$property} && $_attrs{$property} eq $method ) {
      return 1;
    } else {
      croak("invalid property");
    }
  }

  sub _set {
    my ($self, $property, $value) = @_;

    $property = '_' . $property;
    $self->{$property} = $value;
  }

  sub _get {
    my ($self, $property) = @_;

    $property = '_' . $property;
    $self->{$property};
  }
}

sub new {
  my ($class, %params) = @_;

  my $self = bless {
    _title       => $params{title}       || '',
    _description => $params{description} || '',
    _topnote     => $params{topnote}     || '',
    _diagramnote => $params{diagramnote} || '',
    _name        => $params{name}        || '',
    _number      => $params{number}      || '',
    _minwidth    => $params{minwidth}    || 0, 
    _layout      => $params{layout}      || 'stack',
    _loader_file => $params{loader_file} || '',
    _output_file => $params{output_file} || '',
    _coltitles   => $params{coltitles}   || [],
    _colwidths   => $params{colwidths}   || [],
    _boxchars    => $params{boxchars}    || ["+", ".", "'", "`", "-", "|"],
    _colsp       => $params{colsp}       || '  ',
    _sp          => $params{sp}          || ' ',
    _nl          => $params{nl}          || "\n",
    _mlayout     => [],
    _mheight     => [],
    _fnotes      => [],
    _test        => 0
  }, $class;

  Text::ProcessMap::Object::_init();
  
  return $self;
}

sub header {
  my ($self, %params) = @_;

  foreach my $key ( keys %params ) {
    if ( $self->_accessible($key, 'header') ) { $self->_set($key, $params{$key}); }
  }
}

sub body {
  my ($self, %params) = @_;

  foreach my $key ( keys %params ) {
    if ( $self->_accessible($key, 'body') ) { $self->_set($key, $params{$key}); }
  }
}

sub node {
  my ($self, @args) = @_;
  my %params = @args;
  
  # validate column argument
  my $col = $params{col};  # column number range is 1..n
  if ( !defined $col || $col < 1 ) { croak("invalid column number"); }
  
  my $obj = Text::ProcessMap::Object->new(@args, 'parent', $self);
  my $row = $obj->_get_row;
  @{ $self->{_mlayout}[$col] }[$row] = $obj;
}
    
sub draw {
  my ($self, $fd) = @_;

  $fd = '' unless $fd;
  $self->_read_loader;
  $fd = $self->{_output_file} if $self->{_output_file};

  local *OUTPUT;

  # choose between existing filehandle, filename, or stdout
  SWITCH: {
    if ( $fd =~ /::/ ) { *OUTPUT = $fd; last SWITCH; }
    if ( $fd )         { open(OUTPUT, ">$fd") or croak("file open error"); last SWITCH; }
    *OUTPUT = *STDOUT;
  }

  # output the diagram
  print OUTPUT @{$self->_build_header};
  print OUTPUT @{$self->_build_body};
  print OUTPUT @{$self->_build_footer};
}

sub _build_header {
  my $self = shift;
  my @header;

  my $nl = $self->{_nl};
  my $sp = $self->{_sp};
  my $ml_imax = $#{$self->{_mlayout}} - 1;
  
  # must have at least one column
  if ( $ml_imax < 0 ) { 
    croak "no columns defined"; 
  }
  # number of column titles must be same as number of columns
  if ( $#{$self->{_coltitles}} != $ml_imax ) { 
    croak "columns/column-titles mismatch"; 
  }
  # number of column widths must be same as number of columns
  if ( $#{$self->{_colwidths}} != $ml_imax ) { 
    croak "columns/column-widths mismatch"; 
  }
  
  return \@header unless $self->_is_header_fancy;  # empty

  push @header, $self->_separator_line('-');

  my $dwidth = $self->_display_width;
  # title diaplay line
  if ( $self->{_title} ) {
    push @header, map { $_ .= $nl }
      $self->_center_wrap($self->{_title}, $dwidth, $sp);
  }
  # description display line
  if ( $self->{_description} ) {
    push @header, map { $_ .= $nl }
      $self->_center_wrap($self->{_description}, $dwidth, $sp);
  }
  # diagram number display line
  if ( $self->{_number} ) {
    push @header, map { $_ .= $nl }
      $self->_center_wrap('Diagram Number ' . $self->{_number}, $dwidth, $sp);
  }
  # topnote display line
  if ( $self->{_topnote} ) {
    push @header, $self->_separator_line('-');
    push @header, map { $_ .= $nl }
      $self->_center_wrap($self->{_topnote}, $dwidth, $sp);
  }
  my $headline = '';
  my $jstr;
  for my $i ( 0 .. $ml_imax ) 
  {
    if ( $i < $ml_imax ) 
    { 
      $jstr = '||' 
    } 
    else 
    { 
      $jstr = $self->{_nl}; 
    }
    $headline .= $self->_center(@{$self->{_coltitles}}[$i], @{$self->{_colwidths}}[$i]);
    $headline .= $jstr;
  }
  push @header, $self->_separator_line('-');
  push @header, $headline;
  push @header, $self->_separator_line('-') . $self->{_nl};

  return \@header;
}

# ---------------------------------------------------------------------
# _build_body
#
# Build the body section of the diagram. This is done using either a
# stack layout or a matrix layout. When stacking, the column objects 
# are aligned one atop the other with no vertical spacing. When using 
# a matrix layout, the column objects are vertically aligned at their 
# top and spaced one object per row, a row can be empty for any given
# column. The default layout is stack.
# ---------------------------------------------------------------------
sub _build_body {
  my $self = shift;
 
  my $sp = $self->{_sp};
  my $nl = $self->{_nl};
  my $colsp = $self->{_colsp};
  my @clines;  # aoa of lines representing node objects

  # check layout requested
  unless ( $self->{_layout} =~ /^stack$|^matrix$/ ) 
  { 
    croak("invalid layout specificied"); 
  }
  
  my $numcols = $#{$self->{_mlayout}};
  
  # using stack layout
  if ( $self->{_layout} eq 'stack' ) 
  {
    for my $col ( 0 .. $numcols ) 
    {
      my $numrows = $#{ @{ $self->{_mlayout}[$col] } };
      for my $row ( 1 .. $numrows ) 
      {
        if ( defined @{ $self->{_mlayout}[$col] }[$row] )
        {
          my $obj = @{ $self->{_mlayout}[$col] }[$row];
          push @{ $clines[$col - 1] }, @{ $obj->{_boxlines} };
        }
      }
    }
  }
  
  # using matrix layout
  if ( $self->{_layout} eq 'matrix' )
  {
    # determine row heights and save to mheight array
    for my $col ( 0 .. $numcols )                          
    {
      my $numrows = $#{ @{ $self->{_mlayout}[$col] } };
      for my $row ( 1 .. $numrows )                        
      {
        if ( !defined @{ $self->{_mheight} }[$row] )
        {
          @{ $self->{_mheight} }[$row] = 0;
        }
        if ( defined @{ $self->{_mlayout}[$col] }[$row] )  
        {
          my $obj = @{ $self->{_mlayout}[$col] }[$row];    
          my $rheight = $obj->_get_height;                 
          if ( !defined @{ $self->{_mheight} }[$row] )
          {
            @{ $self->{_mheight} }[$row] = 0;
          }
          if ( $rheight > @{ $self->{_mheight} }[$row] )
          {
            @{ $self->{_mheight} }[$row] = $rheight;
          }
        }
      }
    }
    # create blank column objects
    for my $col ( 0 .. $numcols )                          
    {
      my $numrows = $#{ @{ $self->{_mlayout}[$col] } };
      for my $row ( 1 .. $numrows )                        
      {
        if ( !defined @{ $self->{_mlayout}[$col] }[$row] )  
        {
          # create a blank object using prev object attributes
          my $connect = ' ';
          my $boxheight = 0;
          if ( $row > 1 )
          {
            # prev object connect attribute
            my $pobj = @{ $self->{_mlayout}[$col] }[$row-1];    
            $connect = $pobj->_get_connect;
            # current row height
            $boxheight = @{ $self->{_mheight} }[$row];
          }
          # create blank object
          my $obj = Text::ProcessMap::Object->new( 
                    parent    => $self,
                    col       => $col,
                    row       => $row,
                    type      => 'blank',
                    boxheight => $boxheight,
                    connect   => $connect,
                    border    => 'off' );
          # store blank object in layout
          @{ $self->{_mlayout}[$col] }[$row] = $obj;
        }
      }
    }
    # output column objects
    for my $col ( 0 .. $numcols ) 
    {
      my $numrows = $#{ @{ $self->{_mlayout}[$col] } };
      for my $row ( 1 .. $numrows ) 
      {
        if ( defined @{ $self->{_mlayout}[$col] }[$row] )
        {
          my $obj = @{ $self->{_mlayout}[$col] }[$row];
          
          my $height = @{ $self->{_mheight} }[$row];
          $obj->_pad($col-1, $height);
          
          push @{ $clines[$col - 1] }, @{ $obj->{_boxlines} };
        }
      }
    }
  }
  
  # get max column lines
  my @aomax;
  for my $i ( 0 .. $numcols ) {
    push @aomax, $#{ $clines[$i] } - 1;
  }
  @aomax = sort _numerically(@aomax);
  my $linmax = $aomax[0];  # max column lines
 
  # pad all columns to same length
  for my $i ( 0 .. $numcols - 1) {
    my $numrows = $#{ $clines[$i] };  # number of rows in this column
    my $colwid = @{$self->{_colwidths}}[$i];  # width of this column
    push @{ $clines[$i] }, map { $sp x $colwid } $numrows .. $linmax;
  }

  # nest three columns into one array
  my @body;
  for my $i ( 0 .. $linmax ) {
    my $line = '';
    for my $j ( 0 .. $numcols - 1) {
      my $glue = $j < $numcols - 1 ? $colsp : $nl;
      $line .= $clines[$j][$i] . $glue;
    }
    push @body, $line;
  }

  push @body, $nl;
  # add diagramnote after the diagram
  if ( $self->{_diagramnote} ) {
    my $dwidth = $self->_display_width;
    push @body, map { $_ .= $nl }
      $self->_center_wrap($self->{_diagramnote}, $dwidth, $sp);
    push @body, $nl;
  }

  return \@body;  # ref to array of body lines
}

sub _build_footer {
  my $self = shift;
  my @footnotes;
  my $fcnt = 0;
  my $fln = '';

  return \@footnotes unless $self->_is_footer_fancy;  # empty
  
  push @footnotes, $self->_separator_line('-');
  my $sp = $self->{_sp};

  # check for footnotes and output as required
  if ( $#{$self->{_fnotes}} > 0 ) {  
    push @footnotes, 'Footnotes:' . $self->{_nl};
    foreach my $note ( @{ $self->{_fnotes} } ) {
      my $pad = length($note->{_id}) + 1;
      push @footnotes, $note->{_id} . ':' . $note->{_short_name} . $self->{_nl} . $self->{_sp} x $pad . $note->{_long_name} . $self->{_nl};
      $fcnt++;
    }
  }
  if ( $fcnt ) {
    push @footnotes, $self->_separator_line('-');
  }
    
  # add page footer
  if ( $self->{_name} ) {
    $fln = $self->{_name};
    $fln = $self->_append_right($fln, $self->_printed, $self->_display_width);
    push @footnotes, $fln;
    push @footnotes, $self->_separator_line('-');
  }

  return \@footnotes;
}

sub _read_loader {
  my $self = shift;
  my %kvps;
  my ($key, $val);
  my (@elem, @boxc, @colt, @colw);
  my $section;
  my $column;

  unless ( $self->{_loader_file} ) { return; }

  open(LOAD, $self->{_loader_file}) || die "unable to open definition file";
  while ( <LOAD> ) {
    chomp;
    s/^\s+//;
    s/\s+$//;
    next unless $_;
    next if /^#/;  # comments

    if ( /^\[/ ) {  # start new section
      if ( /(header|body|column\s+(\d{1,}))/i ) {  # start of section
        $section = $1;
        $column = $2;
        $section =~ s/\s+\d{1,}//;
        %kvps = ();
        @elem = ();
        @boxc = ();
        @colt = ();
        @colw = ();
        next;
      }
    }
    if ( $section =~ /header/i ) {  # header contains only kvps
      unless ( /^put/ ) {
        $key = $self->_get_key($_);
        $val = $self->_get_val($_);
        $kvps{$key} = $val;
      }
    }
    if ( $section =~ /body/i ) {  # body section can contain kvps and array defs
      if ( /^boxchars|^coltitles|^colwidths/i ) {
        unless ( /^put/i ) {
          if ( /^boxchars/i ) {
            @boxc = $self->_get_arr($_);
          }
          if ( /^coltitles/i ) {
            @colt = $self->_get_arr($_);
          }
          if ( /^colwidths/i ) {
            @colw = $self->_get_arr($_);
          }
        }
      } else {
        unless ( /^put/i ) {
          $key = $self->_get_key($_);
          $val = $self->_get_val($_);
          $kvps{$key} = $val;
        }
      }
    }
    if ( $section =~ /column/i ) {
      if ( /^element/i ) {
        push @elem, $self->_get_val($_);
      } else {
        unless ( /^put/i ) {
          $key = $self->_get_key($_);
          $val = $self->_get_val($_);
          $kvps{$key} = $val;
        }
      }
    }
    if ( /^put/i ) { # /
      if ( $section =~ /body/i ) {
        if ( @boxc ) { $kvps{boxchars}  = [ @boxc ]; }
        if ( @colt ) { $kvps{coltitles} = [ @colt ]; }
        if ( @colw ) { $kvps{colwidths} = [ @colw ]; }
        $self->body(%kvps);
      }
      if ( $section =~ /header/i ) {
        $self->header(%kvps);
      }
      if ( $section =~ /column/i ) {
        $kvps{elements} = [ @elem ];
        $kvps{col} = $column;
        $self->node(%kvps);
      }
      %kvps = ();
      @elem = ();
      next;
    }
  }
  close(LOAD);
}

sub _numerically { 
  $b <=> $a;  # reverse numeric sort
}    

sub _append_right {
  my ($self, $basestr, $addstr, $width) = @_;

  my $pad = $width - length($basestr) - length($addstr);
  return $basestr . $self->{_sp} x $pad . $addstr . $self->{_nl};
}

sub _center {
  my ($self, $str, $width) = @_;

  if ( length($str) >= $width) {
    return substr($str, 0, $width);
  }

  my $lead = int(($width - length($str)) / 2);
  my $trail = int($width - (length($str) + $lead));

  return $self->{_sp} x $lead . $str . $self->{_sp} x $trail;
}

sub _center_wrap {
  my ($self, $str, $width, $sp) = @_;
  my $tmp;
  my @w;

  $width = $width;    
  $str =~ s/\s+/ /g;
  my @str = split ' ', $str;

  @str = map { $self->_cwfix($_, $width) } @str;
  
  my $ll = 0;
  while (@str) {
    my $w = shift(@str);
    if ($ll + length($w) > $width) {
      push @w, $tmp;
      $ll = length($w) + 1;
      $tmp = $w . $sp;
    } else {
      $tmp .= $w . $sp;
      $ll += length($w) + 1;
    }
  }  
  push @w, $tmp if $tmp;

  @w = map { $self->_cwctr($_, $width, $sp) } @w;
  return @w;
}

sub _cwfix {  
  my ($self, $str, $width) = @_;
  if ( length($str) > $width ) {
    $str = substr($str, 0, $width - 1) . '~';
  }
  return $str;
}

sub _cwctr {
  my ($self, $str, $width, $sp) = @_;
  $str =~ s/^\s+|\s+$//g;
  my $lead = int(($width - length($str)) / 2);
  my $tail = int($width - (length($str) + $lead));
  return $sp x $lead . $str . $sp x $tail;
}

sub _is_header_fancy {
  my $self = shift;
  if ( $self->{_title} || $self->{_description} || $self->{_number} ) {
    return 1;
  }
  return 0;
}

sub _is_footer_fancy {
  my $self = shift;
  if ( $#{$self->{_fnotes}} > 0 || $self->{_name} ) {
    return 1;
  }
  return 0;
}

sub _body_width {
  my $self = shift;
  
  my $numcols = $#{$self->{_mlayout}} - 1;
  my $bwidth = 0;

    for my $i ( 0 .. $numcols ) {  
    $bwidth += @{$self->{_colwidths}}[$i];
  }
  $bwidth += ($numcols) * 2;  # add space between cols
  return $bwidth;
}

sub _display_width {
  my $self = shift;
  
  my $bwidth = $self->_body_width;
  my $mwidth = $self->{_minwidth};  
  return $mwidth > $bwidth ? $mwidth : $bwidth;
}

sub _printed {
  my ($self) = @_;

  if ( $self->{_test} ) { return ' 00/00/0000'; }

  my ($sec, $min, $hr, $dy, $mo, $yr, $wd, $doy, $dst) = localtime(time);
  return sprintf(" %02d/%02d/%04d", $mo + 1, $dy, $yr += 1900);
}

sub _separator_line {
  my ($self, $char) = @_;

  my $dwidth = $self->_display_width;
  return $char x $dwidth . $self->{_nl};
}

sub _get_key {
  my ($self, $str) = @_;
  my ($k,$v) = split '=', $str;
  $k =~ s/^\s+//;
  $k =~ s/\s+$//;
  return $k;
}

sub _get_val {
  my ($self, $str) = @_;
  my ($k,$v) = split '=', $str;
  $v =~ s/^\s+//;
  $v =~ s/\s+$//;
  return $v;
}

sub _get_arr {
  my ($self, $str) = @_;
  my ($k,$v) = split '=', $str;
  $v =~ s/^\s+//;
  $v =~ s/\s+$//;
  my @items = split ',', $v;  # extract list items
  @items = map {_trim($_)} @items;  # trim list items
  return @items;  
}

sub _trim {
    my $s = shift;
    $s =~ s/^\s+//g;
    $s =~ s/\s+$//g;
    return $s;
}    

1;

# ---------------------------------------------------------------------
# package Text::ProcessMap::Object;
#
# When a new box is instantiated, the box object immediately invokes
# a function to build an array of lines representing the box and store
# those lines inside of the box object. The array of lines is justified 
# and bordered using preferences supplied by the parent object. This 
# allows the height of the box to be calculated and stored at the same 
# time the box is instantiated.
# ---------------------------------------------------------------------
package Text::ProcessMap::Object;

use Carp;

our $ccol = 1;   # current column
our $crow = 0;   # current row

sub new {
  my ($class, %params) = @_;

  my $self = bless {
    _parent    => $params{parent},
    _col       => $params{col},
    _row       => $params{row}       || 0,               # new 2/21
    _id        => $params{id}        || '',
    _title     => $params{title}     || '',
    _elements  => $params{elements}  || [],
    _in        => $params{in}        || '-',
    _out       => $params{out}       || '-',
    _connect   => $params{connect}   || '',
    _vertex    => $params{vertex}    || '',              # new 2/27
    _header    => $params{header}    || '',              # new 2/21
    _footer    => $params{footer}    || '',              # new 2/21
    _type      => $params{type}      || 'box',           # new 2/21
    _border    => $params{border}    || 'on',            # new 2/21
    _boxheight => $params{boxheight} || 0,               # new 2/27
    _subtype   => 0,                                     # new 2/21
    _footnotes => [],
    _boxlines  => [],
  }, $class;

  unless ( $self->{_connect} ) { 
      $self->{_connect} = $self->{_parent}->{_sp};
  }

  if ( $self->{_type} =~ /^arrow/ )  # get arrow extended attributes
  {  
    $self->{_type} =~ /^arrow:(\d)/;
    $self->{_subtype} = $1 || 0;
    $self->{_type} = 'arrow';
    $self->{_border} = 'off'; 
    $self->{_sp} = $self->{_parent}->{_sp};

    if ( $self->{_subtype} > 3 ) { 
      croak("invalid arrow type");
    }
  }

  unless ( $self->{_type} =~ /^box$|^arrow$|^blank$/ ) { 
    croak("invalid type");
  }

  unless ( $self->{_border} =~ /^on$|^off$/ ) { 
    croak("invalid border type");
  }
  
  # store row info, row is automatically generated if not given
  if ( $self->{_type} =~ /^arrow$|^box$/ )
  {
    $crow++;
    if ( $self->{_col} > $ccol ) { $ccol = $self->{_col}; $crow = 1;}
    if ( $self->{_row} > 0 && $self->{_row} < $crow ) { croak("invalid row sequence"); }
    if ( $self->{_row} > $crow ) { $crow = $self->{_row}; }
    $self->{_row} = $crow;
  } 
   
  $self->_build_box;
            
  return $self;
}

sub _init {
  $ccol = 1;   # reset current column
  $crow = 0;   # reset current row
}

sub _get_row {
  my $self = shift;
  return $self->{_row};
}

sub _get_height {
  my $self = shift;
  return $self->{_boxheight};
}

sub _get_connect {
  my $self = shift;
  return $self->{_connect};
}

# ---------------------------------------------------------------------
# _build_box
# 
# Build the array containing box lines for this box. The lines produced
# comprise a complete image of this particular box instance. The lines
# are stored inside the box object for later reference. 
# ---------------------------------------------------------------------
sub _build_box {
  my $self = shift;
  
  my $parent = $self->{_parent};
  my ($tlch, $trch, $brch, $blch, $hch, $vch) = @{ $parent->{_boxchars} };
  my $width = @{$parent->{_colwidths}}[$self->{_col}-1];  # this column width
  my $sp = $parent->{_sp};  # space char
  my $center = 1;  # default centered, TODO all user defined, stored in parent
  my $border = 0;
  if ( $self->{_border} eq 'on' ) { 
    $border = 1; 
  } else {
    ($tlch, $trch, $brch, $blch, $hch, $vch) = ($sp, $sp, $sp, $sp, $sp, $sp);
  }

  if ( $self->{_type} eq 'box' )
  {
    if ( $border )
    {
      push @{ $self->{_boxlines} },                                   
              $self->_box_line($hch, $tlch, $trch, $self->{_in}, $width);
    }
    if ( $self->{_header} )
    {
      push @{ $self->{_boxlines} },
              $self->_wrap($self->{_header}, $width, $vch, $sp, 1);
      push @{ $self->{_boxlines} },
              $self->_box_line($hch, $vch, $vch, '', $width);
    }
    if ( $self->{_id} )
    {
      push @{ $self->{_boxlines} }, 
              $self->_wrap('['.$self->{_id}.']', $width, $vch, $sp, 1);
    }
    if ( $self->{_title} )
    {
      push @{ $self->{_boxlines} }, 
              $self->_wrap($self->{_title}, $width, $vch, $sp, 1);
    }
    if ( $#{ $self->{_elements} } > -1 )                          
    {
      foreach my $line ( @{ $self->{_elements} } ) 
      {
        push @{ $self->{_boxlines} }, 
                $self->_wrap($line, $width, $vch, $sp, 1);
      }
    }
    if ( $self->{_footer} )                                     
    {
      push @{ $self->{_boxlines} },
              $self->_box_line($hch, $vch, $vch, '', $width);
      push @{ $self->{_boxlines} },
              $self->_wrap($self->{_footer}, $width, $vch, $sp, 1);
    }
    if ( $border ) 
    {
      push @{ $self->{_boxlines} }, 
              $self->_box_line($hch, $blch, $brch, $self->{_out}, $width);
    }
  }

  if ( $self->{_type} eq 'arrow' ) 
  {
    push @{ $self->{_boxlines} },
            $self->_box_line($sp, $sp, $sp, $self->{_connect}, $width);
    if ( $self->{_title} )
    {
      push @{ $self->{_boxlines} }, 
              $self->_wrap($self->{_title}, $width, $sp, $sp, 1);
    }
    push @{ $self->{_boxlines} }, 
            $self->_arr_line($width);
  }

  if ( $self->{_type} eq 'blank' ) 
  {
    if ( $self->{_boxheight} > 0 )
    {
      for ( 1 .. $self->{_boxheight} - 1 )
      {
        push @{ $self->{_boxlines} },                                   
                $self->_box_line($sp, $sp, $sp, $self->{_connect}, $width);
      }
    }
  }

  # all objects get connect space
  if ( $self->{_connect} )
  { 
    push @{ $self->{_boxlines} },
            $self->_box_line($sp, $sp, $sp, $self->{_connect}, $width);
  }

  # store the height  
  $self->{_boxheight} = $#{ $self->{_boxlines} } + 1;  # overall height
}

# ---------------------------------------------------------------------
# _pad
#
# Pad object height to specified number of rows. If a connect char has
# been specified for this object, use that char when padding.
# ---------------------------------------------------------------------
sub _pad {
  my ($self, $col, $height) = @_;

  if ( $height > $self->{_boxheight} )
  {
    my $parent = $self->{_parent};
    my $width = @{ $parent->{_colwidths} }[$col];  # this column width
    my $sp = $parent->{_sp}; 
    for ( $self->{_boxheight} .. $height - 1 ) 
    {
      push @{ $self->{_boxlines} },
              $self->_box_line($sp, $sp, $sp, $self->{_connect}, $width);
    }
  }
}

# ---------------------------------------------------------------------
# _wrap
#
# Accept a string and wrap it to multiple lines of the specified width. 
# Either left justify or center justify the lines depending on 
# argument. Any single word which is longer than the specified width
# is automatically footnoted and the footnote object created is stored 
# in the box's parent object. The string is returned as an array of 
# lines, each line bordered by the specified border char.
# 
# used by:
#   Text::ProcessMap::Object::new
#
# uses:
#   _wftn, _wctr, _wlft
# ---------------------------------------------------------------------
sub _wrap {
  my ($self, $str, $width, $echar, $sp, $center) = @_;
  my $tmp;
  my @w;

  $width = $width - 2;    
  $str =~ s/\s+/ /g;
  my @str = split ' ', $str;

  @str = map { $self->_wftn($_, $width) } @str;
  
  my $ll = 0;
  while (@str) {
    my $w = shift(@str);
    if ($ll + length($w) > $width) {
      push @w, $tmp;
      $ll = length($w) + 1;
      $tmp = $w . $sp;
    } else {
      $tmp .= $w . $sp;
      $ll += length($w) + 1;
    }
  }  
  push @w, $tmp if $tmp;

  if ( $center ) {
    @w = map { $echar . $self->_wctr($_, $width, $sp) . $echar } @w;
  } else {
    @w = map { $echar . $self->_wlft($_, $width, $sp) . $echar } @w;
  }
  
  return @w;
}

# ---------------------------------------------------------------------
# _wftn
#
# Create footnote for word longer than the specified width.
#
# used by: _wrap
# ---------------------------------------------------------------------
sub _wftn {  
  my ($self, $str, $width) = @_;
  # handle single words longer than width
  if ( length($str) > $width ) {
    my $longstr = $str;
    $str = substr($str, 0, $width - 1) . '~';
    
    # create a new footnote object to hold long text
    my $note = Text::ProcessMap::Footnote->new(   # create footnote object
      parent     => $self,
      id         => $self->{_id},
      long_name  => $longstr,
      short_name => $str,
    );
    # store footnote object in parent object
    push @{$self->{_parent}->{_fnotes}}, $note || croak("box stack error");
    
  }
  return $str;
}

# ---------------------------------------------------------------------
# _wlft
#
# Left justify string using specified width.
#
# used by: _wrap
# ---------------------------------------------------------------------
sub _wlft {  
  my ($self, $str, $width, $sp) = @_;
  $str =~ s/^\s+|\s+$//g;
  my $tail = int($width - (length($str)));
  return $str . $sp x $tail;
}

# ---------------------------------------------------------------------
# _wctr
#
# Center string using specified width.
#
# used by: _wrap
# ---------------------------------------------------------------------
sub _wctr {
  my ($self, $str, $width, $sp) = @_;
  $str =~ s/^\s+|\s+$//g;
  my $lead = int(($width - length($str)) / 2);
  my $tail = int($width - (length($str) + $lead));
  return $sp x $lead . $str . $sp x $tail;
}

# ---------------------------------------------------------------------
# _arr_line
#
# Build an arrow object. 
# ---------------------------------------------------------------------
sub _arr_line {
  my ($self, $width) = @_;

  my $subtype = $self->{_subtype};
  my $sp = $self->{_sp};

  my $al = '-' x ($width - 2);  # arrow line
  if ( $subtype == 0 ) { $al = '-'.$al.'-'; }
  if ( $subtype == 1 ) { $al = '<'.$al.'.'; }
  if ( $subtype == 2 ) { $al = '<'.$al.'>'; }
  if ( $subtype == 3 ) { $al = '-'.$al.'>'; }
  return $al;
}

sub _box_line {
  my ($self, @args) = @_;
  my ($hc, $lc, $rc, $cc, $width) = @args;

  $cc = '' unless $cc;  
  
  my $tempc = '~';  # use a temp char to build the string initially
  my $ww = $width - 2;
  my $str = $tempc x $ww;
  my $clen = length($cc);
  my $cloc = int($ww / 2) - int($clen / 2) - 1;

  $str = substr($str,0,$cloc) . $cc . substr($str,$cloc+$clen,$ww);
  $str =~ s/$tempc/$hc/g;  # replace the temp chars with real chars
  return $lc . $str . $rc;
}

1;

package Text::ProcessMap::Footnote;

sub new {
  my ($class, %params) = @_;

  my $self = bless {
    _parent     => $params{parent},
    _col        => $params{col}        || '',
    _id         => $params{id}         || '',
    _long_name  => $params{long_name}  || '',
    _short_name => $params{short_name} || ''
  }, $class;

  return $self;
}

1;

__END__

=pod 

=head1 NAME

Text::ProcessMap - Create process diagrams in plain text format.

=head1 DESCRIPTION

This module provides a text based tool for the generation process diagrams, sometimes called process maps. The process maps produced by this module are similar to UML Interaction Diagrams, only much simpler.

=head1 SYNOPSIS

    use strict;
    use warnings;
    use Text::ProcessMap;

    my $pmap = Text::ProcessMap->new;

    $pmap->header(
        title => 'Hello World',
        name  => 'test'
    );

    $pmap->body(
        coltitles => ['Column 1', 'Column 2', 'Column 3'],
        colwidths => [20, 20, 20],
    );

    $pmap->node(
        col      => 1,
        id       => '11',
        title    => 'My Input',
        elements => [ 'Input Element 1', 'Input Element 2' ]
    );

    $pmap->node(
        col      => 2,
        id       => '21',
        title    => 'My Process',
        elements => [ 'Process Element 1', 'Process Element 2' ]
    );

    $pmap->node(
        col      => 3,
        id       => '31',
        title    => 'My Output',
        elements => [ 'Output Element 1', 'Output Element 2' ]
    );

    $pmap->draw;

=head1 SUMMARY

A process map provides a simple method to document the high-level details of a system process or computer activity.

Information to display can be defined directly in a Perl script using methods provided by the module, or using text based definition files. The definition files are structured like ini files, making them easy to build and maintain.

Output can be directed to either a file or to STDOUT, making it possible to use the module interactively, in batch mode, or as a component in a CGI script.

=head1 SAMPLE DIAGRAM

Below is an example diagram demonstrating the 'matrix' layout option:

 ----------------------------------------------------------------
                              Lorem
                           Lorem Ipsum
                        Diagram Number 1
 ----------------------------------------------------------------
    Lorem Ipsum dolor sit amet, consectetuer adipiscing elit.
 ----------------------------------------------------------------
       Column 1      ||      Column 2      ||      Column 3
 ----------------------------------------------------------------

 +------------------.                        +------------------.
 |      HEADER      |    This is an arrow    |      [I04]       |
 |------------------|    with description    |      Title       |
 |      [I01]       |         text.          |   Lorem Ipsum    |
 |      Title       |  ------------------->  | dolor sit amet,  |
 |   Lorem Ipsum    |                        |   consectetuer   |
 | dolor sit amet,  |                        | adipiscing elit. |
 |   consectetuer   |                        `------------------'
 | adipiscing elit. |                                 |
 |The final element.|                                 |
 `------------------'                                 |
                                                      |
 +------------------.                                 |
 |      [I02]       |                                 |
 |      Title       |                                 |
 |   Lorem Ipsum    |                                 |
 | dolor sit amet,  |                                 |
 |   consectetuer   |                                 |
 | adipiscing elit. |                                 |
 |------------------|                                 |
 |      FOOTER      |                                 |
 `------------------'                                 |
                                                      |
                       +------------------.           |
                       | This is a header |           |
                       |showing word wrap.|           |
                       |------------------|           |
                       |      [I03]       |           |
                       |      Title       |           |
                       |   Lorem Ipsum    |           |
                       | dolor sit amet,  |           |
                       |   consectetuer   |           |
                       | adipiscing elit. |           |
                       |------------------|           |
                       | This is a footer |           |
                       |showing word wrap.|           |
                       `------------------'           |
                                                      |
                                             +------------------.
                                             |      [I05]       |
                                             |      Title       |
                                             |   Lorem Ipsum    |
                                             | dolor sit amet,  |
                                             |   consectetuer   |
                                             | adipiscing elit. |
                                             `------------------'

 Lorem Ipsum dolor sit amet, consectetuer adipiscing elit.

 ----------------------------------------------------------------
 lorem_ipsum                                           02/28/2005
 ----------------------------------------------------------------

=head1 METHODS

=head2 new()

No required parameters. You may optionally provide any of the parameters accepted by the header() and body() methods described below. Arguments are passed using an anonymous hash.

    my $pmap = Text::ProcessMap->new;

=head2 header()

Use this method to set the header characteristics and other general attributes of the process map. Arguments are passed using an anonymous hash.

    $pmap->header(
        title       => 'Hello World',
        description => 'The Hello World Process',
        topnote     => 'This note will be displayed in the header',
        diagramnote => 'This note will be displayed in the footer',
        number      => '1',                       # displayed in header
        name        => 'A name for the diagram',  # displayed in footer
        loader_file => 'sample1',
        output_file => 'output1',
    );

=head2 body()

Use this method to set the body characteristics of the Activity Diagram. Arguments are passed using an anonymous hash. 

    $pmap->body(
        layout      => 'stack',  # can be either 'stack' or 'matrix'
        coltitles   => ['Column 1', 'Column 2', 'Column 3'],
        colwidths   => [20, 20, 20],
        boxchars    => ["+", ".", "'", "`", "-", "|"],  # default
    );

=head2 node()

Use this method to define diagram objects. Arguments are passed using an anonymous hash. The example below demonstrates the use of all the arguments accepted by the node method. Each method call generates a single diagram object.

    $pmap->node(
        col      => 2,
        row      => 3,
        id       => 'I03',
        header   => 'This is a header showing word wrap.',
        title    => 'Title',
        elements => ['Lorem Ipsum','dolor sit amet,','consectetuer','adipiscing elit.'],
        footer   => 'This is a footer showing word wrap.'
    );

=head2 draw()

Draws the diagram. If no argument is provided, the diagram will be sent to STDOUT. Other arguments accepted are an existing file handle or a file name to be created.

    $pmap->draw;             # output to STDOUT

    $pmap->draw(*DIAG);      # use file handle

    $pmap->draw($filename);  # create file $filename

=head1 DEFINITION FILES

A definition file is a diagram definition that can be read at run-time. This allows the you to build and maintain a library of process maps. A sample definition file is shown below. The definition files are similar to ini files, each section of the file provides input to a method, the word B<put> is used to indicate when a method should be invoked. This definition file was used to create the sample diagram shown above.

 [Header]

 title       = Lorem
 description = Lorem Ipsum
 topnote     = Lorem Ipsum dolor sit amet, consectetuer adipiscing elit.
 diagramnote = Lorem Ipsum dolor sit amet, consectetuer adipiscing elit.
 name        = lorem_ipsum
 number      = 19          
 put

 [Body]

 colwidths = 20,20,20
 coltitles = Column 1,Column 2,Column 3
 layout    = matrix
 put

 [Column 1]

 row     = 1
 id      = I01
 title   = Title
 header  = HEADER
 element = Lorem Ipsum
 element = dolor sit amet,
 element = consectetuer
 element = adipiscing elit.
 element = The final element.
 put

 row     = 2
 id      = I02
 footer  = FOOTER
 title   = Title
 element = Lorem Ipsum
 element = dolor sit amet,
 element = consectetuer
 element = adipiscing elit.
 put

 [Column 2]

 row   = 1
 type  = arrow:3
 title = This is an arrow with description text.
 put

 row     = 3
 id      = I03
 header  = This is a header showing word wrap.
 title   = Title
 element = Lorem Ipsum
 element = dolor sit amet,
 element = consectetuer
 element = adipiscing elit.
 footer  = This is a footer showing word wrap.
 put

 [Column 3]

 row     = 1
 id      = I04
 title   = Title
 element = Lorem Ipsum
 element = dolor sit amet,
 element = consectetuer
 element = adipiscing elit.
 connect = |
 put

 row     = 4
 id      = I05
 title   = Title
 element = Lorem Ipsum
 element = dolor sit amet,
 element = consectetuer
 element = adipiscing elit.
 put

=head1 TEXT FORMATTING

Text entries are automatically word-wrapped to multiple lines. There is one exception to this rule, if a word is longer then the width of a diagram object, it will be truncated and a footnote generated for that word. The footnote will show the original word alongside its truncted version.

=head1 REFERENCES

Scott Ambler, Agile Modeling: http://www.agilemodeling.com/

UML Distilled, Third Edition. Scott Ambler.

=head1 AUTHOR

Copyright 2005, Brad J. Adkins. All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Address bug reports and comments to: bradjadkins@badkins.net.

If you find this module useful, please feel free to send the Author an email and describe how you are using it. Thanks.

=head1 CREDITS

Thanks are in order to the following individuals for their suggestions.

Joel and Doug.

=head1 BUGS

Address bug reports and comments to: bradjadkins@badkins.net.

=head1 TODO

Some additional arrow types would be nice, but consideration will need to go into the approach used to define arrows in order to accomplish this.

=head1 SEE ALSO

Text::Flowchart