Text::FixedWidth - Easy OO manipulation of fixed width text files

   use Text::FixedWidth;

   my $fw = new Text::FixedWidth;
   $fw->set_attributes(qw(
      fname            undef  %10s
      lname            undef  %-10s
      points           0      %04d
   ));

   $fw->parse(string => '       JayHannah    0003');
   $fw->get_fname;               # Jay
   $fw->get_lname;               # Hannah
   $fw->get_points;              # 0003

   $fw->set_fname('Chuck');
   $fw->set_lname('Norris');
   $fw->set_points(17);
   $fw->string;                  # '     ChuckNorris    0017'

  $fw->set_attributes(qw(
    fname            undef  %10s
    lname            undef  %-10s
    points           0      %04d
  );

  $fw->parse(string => '       JayHannah    0003');

  print $fw->string;      #  '     ChuckNorris    0017'

  $fw->auto_truncate("fname", "lname");

   my $fw_copy = $fw->clone;

   while( my $row = $fw->parse( clone => 1, string => $str ) ) {
      print $row->foobar;
   }

    perldoc Text::FixedWidth

package Text::FixedWidth;

use warnings;
use strict;
use Carp;
use vars ('$AUTOLOAD');
use Storable ();

our $VERSION = '0.08';

sub new {
   my ($caller,%args) = (@_);

   my $caller_is_obj = ref($caller);
   my $class = $caller_is_obj || $caller;
   my $self = bless {}, ref($class) || $class;
   return $self;
}

sub set_attributes {
   my ($self, @att) = @_;

   my $order_by = 1;
   unless (@att % 3 == 0) { die "set_attributes() requires sets of 3 parameters"; }
   while (@att) {
      my ($att, $value, $sprintf) = splice @att, 0, 3;
      if (exists $self->{_attributes}{$att}) {
         die "You already set attribute name '$att'! You can't set it again! All your attribute names must be unique";
      }
      if ($value eq "undef") { $value = undef; }
      $order_by++;
      $self->{_attributes}{$att}{sprintf} = $sprintf;
      $self->{_attributes}{$att}{value}   = $value;
      my ($length) = ($sprintf =~ /(\d+)/g);
      $self->{_attributes}{$att}{length}  = $length;
      push @{$self->{_attribute_order}}, $att;
   }

   return 1;
}

sub parse {
   my ($self, %args) = @_;

   die ref($self).":Please provide a string argument" if (!$args{string});
   my $string = $args{string};

   $self = $self->clone if $args{clone};

   my $offset = 0;
   foreach (@{$self->{_attribute_order}}) {
      my $length = $self->{_attributes}{$_}{length};
      $self->{_attributes}{$_}{value}  = substr $string, $offset, $length;
      $offset += $length;
   }

   return $args{clone}? $self : 1;
}

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

   my ($value, $length, $sprintf, $return);
   foreach my $att (@{$self->{_attribute_order}}) {
      $value   = $self->{_attributes}{$att}{value};
      $length  = $self->{_attributes}{$att}{length};
      $sprintf = $self->{_attributes}{$att}{sprintf};

      if (defined ($value) and length($value) > $length) {
         warn "string() error! " . ref($self) . " length of attribute '$att' cannot exceed '$length', but it does. Please shorten the value '$value'";
         return 0;
      }
      if (not defined $value) {
         $value = '';
      }
      unless ($sprintf) {
         warn "string() error! " . ref($self) . " sprintf not set on attribute $att. Using '%s'";
         $sprintf = '%s';
      }

      my $tmp;
      if (
         $sprintf =~ /\%\d*[duoxefgXEGbB]/ && (       # perldoc -f sprintf
            (not defined $value) ||
            $value eq "" ||
            $value !~ /^(\d+\.?\d*|\.\d+)$/        # match valid number
         )
      ) {
         $value = '' if (not defined $value);
         warn "string() warning: " . ref($self) . " attribute '$att' contains '$value' which is not numeric, yet the sprintf '$sprintf' appears to be numeric. Using 0";
         $value = 0;
      }
      $tmp = sprintf($sprintf, (defined $value ? $value : ""));

      if (length($tmp) != $length) {
         die "string() error: " . ref($self) . " is loaded with an sprintf format which returns a string that is NOT the correct length! Please correct the class! The error occured on attribute '$att' converting value '$value' via sprintf '$sprintf', which is '$tmp', which is not '$length' characters long";
      }

      $return .= $tmp;
   }

   return $return;
}

sub auto_truncate {
   my ($self, @attrs) = @_;
   $self->{_auto_truncate} = {};
   foreach my $attr (@attrs) {
      unless ($self->{_attributes}{$attr}) {
         carp "Can't auto_truncate attribute '$attr' because that attribute does not exist";
         next;
      }
      $self->{_auto_truncate}->{$attr} = 1;
   }
   return 1;
}

sub clone {
   my $self = shift;
   return Storable::dclone($self);
}




sub DESTROY { }

# Using Damian methodology so I don't need to require Moose.
#    Object Oriented Perl (1st edition)
#    Damian Conway
#    Release date  15 Aug 1999
#    Publisher   Manning Publications
sub AUTOLOAD {
  no strict "refs";
  if ($AUTOLOAD =~ /.*::get_(\w+)/) {
    my $att = $1;
    *{$AUTOLOAD} = sub {
      croak "Can't get_$att(). No such attribute: $att" unless (defined $_[0]->{_attributes}{$att});
      my $ret = $_[0]->{_attributes}{$att}{value};
      $ret =~ s/\s+$// if $ret;
      $ret =~ s/^\s+// if $ret;
      return $ret;
    };
    return &{$AUTOLOAD};
  }

  if ($AUTOLOAD =~ /.*::set_(\w+)/) {
    my $att  = $1;
    *{$AUTOLOAD} = sub {
      my $self = $_[0];
      my $val  = $_[1];
      croak "Can't set_$att(). No such attribute: $att" unless (defined $self->{_attributes}{$att});
      if (defined $self->{_attributes}{$att}) {
        if (defined $val && length($val) > $self->{_attributes}{$att}{length}) {
          if ($self->{_auto_truncate}{$att}) {
            $val = substr($val, 0, $self->{_attributes}{$att}{length});
            $self->{_attributes}{$att}{value} = $val;
          } else {
            carp "Can't set_$att('$val'). Value must be " .
              $self->{_attributes}{$att}{length} . " characters or shorter";
            return undef;
          }
        }
        $self->{_attributes}{$att}{value} = $val;
        return 1;
      } else {
        return 0;
      }
    };
    return &{$AUTOLOAD};
  }

  confess ref($_[0]).":No such method: $AUTOLOAD";
}

1; # End of Text::FixedWidth