File Coverage

blib/lib/File/MultiCat.pm

Criterion	Covered	Total	%
statement	40	43	93.0
branch	12	22	54.5
condition			n/a
subroutine	7	8	87.5
pod			n/a
total	59	73	80.8

package File::MultiCat;
use 5.008;
use strict;
# use -w;  -- replaced by the better...
use warnings;
# require Exporter;
# our @ISA = qw(Exporter);
# our %EXPORT_TAGS = ( 'all' => [qw(multicat)] );
# our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
# our @EXPORT = qw();
our $VERSION = '0.04';

# use vars qw(@f $f @ar $ar $fout);
use subs qw(new multicat _multicat_error);

sub new {
  my $class = shift;
  my($self)= {};
  bless ($self, $class);
  # multicat($ar);
  return ($self);
}

sub multicat {
  use vars qw(@f $f $ar @ar $fout $self);
  ($self, $ar) = @_;
  #Get the name of the site description file, open it, or open default multicat.dat
  if ($ar) {
   open(IN, $ar ) || _multicat_error('open', 'file');
  } else {
   open(IN, "multicat.dat") || _multicat_error('open', 'file', 'multicat.dat');
  }
  @f = ;
  close IN || _multicat_error('close', 'file', 'multicat.dat');

  foreach $f (@f){
  # take each line of the site description file
    my (@splitLine, $ofi, $ifi);

    $f =~ s/#.*//;
    # strip comments

    # @splitLine=split(/ +/, $f);
    if($f) {@splitLine = split(' ', $f);}
      # split the line, at any number of space characters, into an array
    if (@splitLine) {$ofi = pop(@splitLine); }

      # remove last item in line, the  output filename; ('pop' it),dddd
      # leaving the rest of the line in @splitline.
    if (@splitLine){
      # test because multicat.dat might have empty lines
      # and throw an error otherwise.
        open(OUT, ">$ofi") || _multicat_error('opensk', 'file', $ofi);
          #open line's output file, the last filename on the line
        foreach $ifi (@splitLine) {
          # print "-$ifi-";
            # take each remaining filename from the line
          open(XIN, "<$ifi")|| _multicat_error('open', 'file', $ifi);
          my @dat = ;
            # write that file's data, in order read in,
            # to the line's output file
          print OUT "@dat\n";
          close XIN || _multicat_error('close', 'file', $ifi);
        }
        close OUT || _multicat_error('close', 'file', $ofi); #close line's output file
    }
  }
  return 1;
}

sub _multicat_error{
   print "problem, can't $_[0] a $_[1], named $_[2]";
   exit;   # or comment this line out and do not exit
}

1;
__END__