The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/perl -w

# Copyright 1999-2013, Paul Johnson (paul@pjcj.net)

# This software is free.  It is licensed under the same terms as Perl itself.

# The latest version of this software should be available from my homepage:
# http://www.pjcj.net

# Version 1.19 - 18th August 2013

use strict;

require 5.005;

package Lines;

use File::Basename;
use Test;

use vars qw($VERSION);
$VERSION = "1.19";

use Gedcom 1.19;

sub test
{
  my $class = shift;
  my (%args) = @_;

  die "tests not specified" unless defined $args{tests};
  plan tests => $args{tests};

  $args{gedcom_file} = (-d "t" ? "" : "../") ."royal.ged"
    unless defined $args{gedcom_file};

  die "report not specified" unless defined $args{report};

  if (defined $args{report_command})
  {
    $args{lines} = "/home/pjcj/ged/other/lines/bin/lines302"
      unless defined $args{lines};

    if ( -x $args{lines} && open(L, "|$args{lines}"))
    {
      my $db = basename($args{gedcom_file}, "\.ged");
      system "rm -rf $db";
      print L "$db\n";
      print L "yur$args{gedcom_file}\n ";
      print L "r$args{report}\n";
      print L "$args{report_command}";
      print L "q";
      close(L) or die "Can't close <$args{lines}>";
      print "\n";
    }
  }
  ok 1;

  $args{perl_program} = "$args{report}.plx" unless defined $args{perl_program};
  if ($args{generate})
  {
    system((-d "t" ? "" : "../") .
           "lines2perl -quiet $args{report} > $args{perl_program}");
    ok $? == 0;
  }
  else
  {
    ok 1;
  }

  $args{lines_report} = "$args{report}.l" unless defined $args{lines_report};
  $args{perl_report}  = "$args{report}.p" unless defined $args{perl_report};

  die "perl_command not specified" unless defined $args{perl_command};
  my $command = "|$^X " . (-d "t" ? "" : "-I .. ") .
                "$args{perl_program} -quiet -gedcom_file $args{gedcom_file} " .
                "> $args{perl_report}";
  open P, $command or die "Can't run <$command>";
  select P;
  $| = 1;
  print P $args{perl_command};
  close(P) or die "Can't close <$args{perl_program}>";
  ok 1;

  # check the gedcom file is correct
  ok open LO, $args{lines_report};
  ok open PO, $args{perl_report};
  ok <PO>, $_ while <LO>;
  ok eof PO;
  ok close PO;
  ok close LO;
  # ok unlink $args{perl_report};
}

sub import
{
  my $class = shift;
  $class->test(@_) if @_;
}

1;