File Coverage

blib/lib/Text/TreeFile.pm

Criterion	Covered	Total	%
statement	9	98	9.1
branch	0	52	0.0
condition	0	30	0.0
subroutine	3	6	50.0
pod	0	1	0.0
total	12	187	6.4

#                             file:  Text/TreeFile.pm
#
#   Copyright (c) 2000 John Kirk. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
#   The latest version of this module should always be available
# at any CPAN (http://www.cpan.org) mirror, or from the author:
#              http://perl.dystanhays.com/jnk

package Text::TreeFile;

use strict;
use vars qw($VERSION @ISA @EXPORT_OK);

require Exporter;
require AutoLoader;

$VERSION=0.39;
@ISA=qw(Exporter AutoLoader);
@EXPORT_OK=qw(showlines showglobals);

require 5.002;
use FileHandle;    # nice to easily have filehandles as plain variables

my %proto=( 'endq'=>undef,'top'=>undef,'idir'=>undef,'iname'=>undef,
            'nest'=>undef,'level'=>undef,'line'=>undef,'lev'=>undef, );

sub _loadtree;
sub _readspec;
sub showlines;
sub showglobals;

sub new { my ($that,$iname,$endq)=@_;
  my $class=ref($that)||$that;
  my $me={_prop=>\%proto,%proto,};
  bless $me,$class;
  if(defined $endq) { $$me{endq}=$endq; }
  if(defined $iname) { $$me{iname}=$iname;
    $iname=~/^(.*\/)([^\/]*)$/;
    $$me{idir}=(defined $1 and $1 ne '')?$1:'';
    $$me{top}=_loadtree $me or return undef;
  }
  return $me;
}

sub _loadtree { my $me=shift;
  my ($spec,$cnt);
  if(!defined $$me{nest}) {
    $$me{nest}=0;
    $$me{lev}=[{'cum'=>0,'lev'=>0,'ifn'=>undef,'ifh'=>undef,'ifl'=>undef,}];
    if(defined $$me{endq}) {
      $spec=[];
      $cnt=0;
    }
  }
  my $lp=$$me{lev}[$$me{nest}];
  if((!defined $$lp{ifh})&&($$me{nest}==0)) {
    if(exists $$me{iname} and defined $$me{iname}) {
      $$lp{ifn}=$$me{iname};
    } else {
      print "_loadtree(): wasn't given a filename at the top file nesting level\n";
      return undef;
    }
  }
  if(!defined $$lp{ifn}) {
    print "_loadtree() got no input filename at file nesting level $$me{nest}\n";
    return undef;
  } elsif(!defined $$lp{ifh}) {
    $$lp{ifh}=new FileHandle "<$$lp{ifn}";
    $$me{line}=undef;
  }
  if(!defined $$lp{ifh}) {
    print "_loadtree() couldn't open ifile: $$lp{ifn}\n";
    return undef;
  }
  if(!defined $$me{line}) {
    ($$me{level},$$me{line})=_readspec $$lp{ifh},$$lp{ifl};
  }
  while(defined $$me{line}) { # loop on top-level specs; test eof from readspec
    if($$me{line}=~/^include\s+(\S+)/) {
      my $iname="$$me{idir}$1";
      my ($cum,$lev)=($$me{lev}[$$me{nest}]{cum},$$me{lev}[$$me{nest}]{lev});
      ++$$me{nest};
      $$me{lev}[$$me{nest}]={
        'cum'=>$cum+$lev,'lev'=>0,'ifn'=>$iname,'ifh'=>undef,'ifl'=>undef,
      };
      if(defined $cnt) { $$spec[$cnt++]=_loadtree($me); }
      else             { $spec         =_loadtree($me); }

      --$$me{nest};
      ($$me{level},$$me{line})=_readspec $$lp{ifh},$$lp{ifl};
    } else {
      my @specs=();
      if(defined $cnt) { $$spec[$cnt++]=[$$me{line},\@specs]; }
      else             { $spec         =[$$me{line},\@specs]; }
      ($$me{level},$$me{line})=_readspec $$lp{ifh},$$lp{ifl};
      my $sublevel=(++$$lp{lev});
      while((defined $$me{level}) && ($$me{level}==$sublevel)) {
        push @specs,_loadtree($me);
      }
      --$$lp{lev};
    }
    last if(!defined $cnt);
  }
  return $spec;
}

sub _readspec { my $ifh=shift;
  if(!defined $_[0]) {
    while(<$ifh>) { # this is the first line of a file
      next if(/^exec\s/ or /^[#;\/]/ or /^\s*\.\.\./ or /^\s*$/);
      last;
    }
    if(eof($ifh)) {
      $_[0]='';
      return (0,undef);
    }
    chop;
    $_[0]=$_;
  }
  if(!defined $_[0]) {
    return (undef,undef);
  }
  if($_[0] eq '') {
    return (0,undef);
  }
  my ($indent,$line,$str);
  ($indent,$line)=$_[0]=~/^([ ]*)(.*)$/;
  my $level=length($indent)/2;
  die "indent. not a mult. of two spaces\n" if($level*2!=length($indent));
  while(<$ifh>) {
    next if(/^[#;]/ or /^\s*\.\.\.\s*$/ or /^\s*$/);
    chop;
    ($indent,$str)=/^(\s*)\.\.\.(.*)$/;
    if(defined $str) {
      $str=~s/^\s+/\ /;
      $line.=$str;
      next;
    }
    $_[0]=$_;
    last;
  }
  if(eof($ifh)) {
    $_[0]='' if(!defined $_);
  }
  return ($level,$line);
}

1;

__END__