Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Version 1.09

  • Loading branch information...
commit af7dbd37797fe9cbecf5fcdb7ed5fcff33b99774 1 parent c93cbe4
@pjcj authored
Showing with 619 additions and 273 deletions.
  1. +12 −1 CHANGES
  2. +28 −21 Gedcom.pm
  3. +152 −0 Gedcom/CGI.pm
  4. +5 −5 Gedcom/Event.pm
  5. +5 −5 Gedcom/Family.pm
  6. +5 −5 Gedcom/Grammar.pm
  7. +4 −4 Gedcom/Grammar_5_5.pm
  8. +6 −5 Gedcom/Individual.pm
  9. +139 −45 Gedcom/Item.pm
  10. +5 −5 Gedcom/LifeLines.pm
  11. +14 −8 Gedcom/Record.pm
  12. +3 −0  MANIFEST
  13. +51 −63 Makefile.PL
  14. +3 −3 README
  15. +48 −0 cgi-bin/gedcom.cgi
  16. +15 −7 ged
  17. +1 −1  gedcom.vim
  18. +13 −13 lines2perl
  19. +7 −7 parse_grammar
  20. +1 −1  royal.ged
  21. +21 −0 session.vim
  22. +6 −6 t/Basic.pm
  23. +5 −5 t/Engine.pm
  24. +10 −9 t/Lines.pm
  25. +3 −3 t/basic.t
  26. +6 −4 t/bias.t
  27. +4 −4 t/birthdates.t
  28. +6 −4 t/lines.t
  29. +2 −2 t/lines/bias
  30. +8 −8 t/lines/bias.plx
  31. +4 −4 t/lines/lines.plx
  32. +4 −4 t/lines/namefreq.plx
  33. +6 −4 t/namefreq.t
  34. +2 −2 t/parse_grammar.t
  35. +3 −3 t/read_only.t
  36. +3 −3 t/resolve.t
  37. +3 −3 t/resolve_read_only.t
  38. +6 −6 tkged
View
13 CHANGES
@@ -130,7 +130,7 @@ Release 1.06 - 13th February 2000
Gedcom::Grammar::child() Gedcom::Grammar::item()
Gedcom::Grammar::children() Gedcom::Grammar::items()
Gedcom::Grammar::valid_children() Gedcom::Grammar::valid_items()
- - Allow has accessor functions in Gedcom::Item to set data too.
+ - Allow accessor functions in Gedcom::Item to set data too.
- Bless appropriate objects into Gedcom::Event.
- Add an experimental write_xml().
- Add tutorial section to documentation.
@@ -147,3 +147,14 @@ Release 1.08 - 8th May 2000
- Allow xrefs to match .+ instead of \w+\d+
- Make XML output valid.
- Allow extra sub-items of a grammar structure.
+
+Release 1.09 - 12th February 2001
+ - Improved XML output especially with respect to notes.
+ - Quietened some spurious warnings.
+ - Fixed some bugs reported by users that I don't recall at the moment.
+ - Add index file to speed up read_only option.
+ - Read files with binmode - keeps Windows happy.
+ - Correct line numbers of errors.
+ - Use File::Spec so tests pass under Windows.
+ - Allow for creation of ppms.
+ - Added Gedcom::CGI and cgi-bin/gedcom.cgi.
View
49 Gedcom.pm
@@ -1,9 +1,9 @@
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# documentation at __END__
@@ -22,7 +22,7 @@ use vars qw($VERSION $Tags);
BEGIN
{
- $VERSION = "1.08";
+ $VERSION = "1.09";
$Tags =
{
@@ -158,10 +158,10 @@ BEGIN
};
}
-use Gedcom::Grammar 1.08;
-use Gedcom::Individual 1.08;
-use Gedcom::Family 1.08;
-use Gedcom::Event 1.08;
+use Gedcom::Grammar 1.09;
+use Gedcom::Individual 1.09;
+use Gedcom::Family 1.09;
+use Gedcom::Event 1.09;
sub new
{
@@ -169,10 +169,8 @@ sub new
my $class = ref($proto) || $proto;
my $self =
{
- buffer => [],
records => [],
tags => $Tags,
- tie => 0,
read_only => 0,
types => {},
xrefs => {},
@@ -225,7 +223,6 @@ sub new
callback => $self->{callback});
$self->{record}{items} = [ Gedcom::Record->new(tag => "TRLR") ]
unless @{$self->{record}{items}};
-
$self->collect_xrefs;
}
$self;
@@ -250,13 +247,13 @@ sub write_xml
<!--
This output was generated by Gedcom.pm.
-Gedcom.pm is Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
-Version 1.08 - 8th May 2000
+Gedcom.pm is Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
+Version 1.09 - 12th February 2001
Gedcom.pm is free. It is licensed under the same terms as Perl itself.
The latest version of Gedcom.pm should be available from my homepage:
-http://www.pjcj.fsnet.co.uk
+http://www.pjcj.net
EOH
$self->{fh}->print("Generated on " . localtime() . "\n\n-->\n\n");
@@ -415,7 +412,7 @@ sub get_individual
my $ordered = sub
{
my ($n, @ind) = @_;
- map { $_->[1] } grep { $_->[0] =~ $n } @ind
+ map { $_->[1] } grep { $_ && $_->[0] =~ $n } @ind
};
# search for the name in any order
@@ -444,7 +441,9 @@ sub get_individual
# Store the name with the individual to avoid continually recalculating it.
# This is a bit like a Schwartzian transform, with a grep instead of a sort.
- my @ind = map { [ $_->tag_value("NAME") => $_ ] } @individuals;
+ my @ind =
+ map { [ do { my $n = $_->tag_value("NAME"); defined $n ? $n : "" } => $_ ] }
+ @individuals;
for my $n ( map { qr/^$_$/, qr/\b$_\b/, $_ } map { $_, qr/$_/i } qr/\Q$name/ )
{
@@ -493,7 +492,7 @@ __END__
Gedcom - a module to manipulate Gedcom genealogy files
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
=head1 SYNOPSIS
@@ -502,9 +501,11 @@ Version 1.08 - 8th May 2000
my $ged = Gedcom->new(gedcom_file => $gedcom_file);
my $ged = Gedcom->new(grammar_version => 5.5,
gedcom_file => $gedcom_file,
+ read_only => 1,
callback => $cb);
my $ged = Gedcom->new(grammar_file => "gedcom-5.5.grammar",
gedcom_file => $gedcom_file);
+
return unless $ged->validate;
my $xref = $self->resolve_xref($value);
$ged->resolve_xrefs;
@@ -521,12 +522,12 @@ Version 1.08 - 8th May 2000
=head1 DESCRIPTION
-Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
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.fsnet.co.uk
+http://www.pjcj.net
This module provides for manipulation of Gedcom files. Gedcom is a
format for storing genealogical information designed by The Church of
@@ -763,6 +764,12 @@ provided that not too much of the gedcom file is needed. If the whole
of the gedcom file needs to be read, for example to validate it, or to
write it out in a different format, then this option should not be used.
+When using the read_only option an index file is kept which can also
+speed up operations. It's usage should be transparant, but will require
+write access to the directory containing the gedcom file. If you access
+individuals only by their xref (eg I20) then the index file will allow
+only the relevant parts of the gedcom file to be read.
+
With or without the read_only option, the gedcom file is accessed in the
same fashion and the data structures can be changed. In this respect,
the name read_only is not very accurate, but since changing the Gedcom
@@ -770,11 +777,11 @@ data will generally mean that the data will be written which means that
the data will first be read, the read_only option is generally useful
when the data will not be written and when not all the data will be
read. You may find it useful to experiment with this option and check
-the amount of CPU time and memroy that your application uses.
+the amount of CPU time and memory that your application uses.
callback is an optional reference to a subroutine which will be called
-at various times while the gedcom file (and the grammar file, ir
-applicable) is being read. It's purpose is to provide feedback during
+at various times while the gedcom file (and the grammar file, if
+applicable) is being read. Its purpose is to provide feedback during
potentially long operations. The subroutine is called with five
arguments:
View
152 Gedcom/CGI.pm
@@ -0,0 +1,152 @@
+# Copyright 2001, Paul Johnson (pjcj@cpan.org)
+
+# 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
+
+# documentation at __END__
+
+use strict;
+
+require 5.005;
+
+package Gedcom::CGI;
+
+use CGI qw(:cgi :html);
+
+use Gedcom 1.09;
+
+use vars qw($VERSION);
+$VERSION = "1.09";
+
+sub gedcom
+{
+ my ($gedcom_file) = @_;
+ $gedcom_file = "/home/pjcj/ged/latest/$gedcom_file.ged";
+ Gedcom->new(gedcom_file => $gedcom_file,
+ read_only => 1);
+}
+
+sub dates
+{
+ my ($i) = @_;
+ "(" . ($i->get_value("birth date") || "") . " - "
+ . ($i->get_value("death date") || "") . ")"
+}
+
+sub indi_link
+{
+ my ($g, $i) = @_;
+ return p("Unknown") unless $i;
+ p(
+ a({-href => "/cgi-bin/gedcom.cgi?op=indi&gedcom=$g&indi=" . $i->xref},
+ $i->cased_name) .
+ " " . dates($i)
+ )
+}
+
+sub main
+{
+ my $gedcom = param("gedcom");
+ my $ged = gedcom($gedcom);
+ print header,
+ start_html,
+ h1($gedcom),
+ map(indi_link($gedcom, $_), $ged->individuals),
+ end_html;
+}
+
+sub event_row
+{
+ my ($n, @e) = @_;
+ map { td
+ ([
+ $n,
+ $_->get_value("date") || "-",
+ $_->get_value("place") || "-",
+ ])
+ } @e
+}
+
+sub indi_row
+{
+ my ($g, $n, @i) = @_;
+ map { td
+ ([
+ $n,
+ a({-href => "/cgi-bin/gedcom.cgi?op=indi&gedcom=$g&indi=" . $_->xref},
+ $_->cased_name),
+ $_->get_value("birth date") || "-",
+ $_->get_value("death date") || "-",
+ ])
+ } @i
+}
+
+sub indi
+{
+ my $gedcom = param("gedcom");
+ my $indi = param("indi");
+ my $ged = gedcom($gedcom);
+ my $i = $ged->get_individual($indi);
+ my $name = $i->cased_name;
+ my $sex = uc $i->sex;
+ my $spouse = $sex eq "M" ? "wife" : $sex eq "F" ? "husband" : "spouse";
+ print header,
+ start_html(-title => $name),
+ h1($name),
+ table
+ (
+ { -border => undef },
+ Tr
+ (
+ { align => "CENTER", valign => "TOP" },
+ [
+ th([ "Event", "Date", "Place"]),
+ event_row("Birth", $i->birth),
+ event_row("Christening", $i->christening),
+ event_row("Death", $i->death),
+ event_row("Burial", $i->burial),
+ event_row("Marriage", $i->get_record(qw(fams marriage))),
+ ]
+ )
+ ),
+ p,
+ table
+ (
+ { -border => undef },
+ Tr
+ (
+ { align => "CENTER", valign => "TOP" },
+ [
+ th([ "Relation", "Name", "Birth", "Death"]),
+ indi_row($gedcom, ucfirst $spouse ,$i->$spouse()),
+ indi_row($gedcom, "Father", $i->father),
+ indi_row($gedcom, "Mother", $i->mother),
+ indi_row($gedcom, "Child", $i->children),
+ ]
+ )
+ ),
+ p(a({-href => "/cgi-bin/gedcom.cgi?op=main&gedcom=$gedcom"}, $gedcom)),
+ end_html;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Gedcom::CGI - Basic CGI routines for Gedcom.pm
+
+Version 1.09 - 12th February 2001
+
+=head1 SYNOPSIS
+
+ use Gedcom::CGI;
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=cut
View
10 Gedcom/Event.pm
@@ -1,9 +1,9 @@
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# documentation at __END__
@@ -13,10 +13,10 @@ require 5.005;
package Gedcom::Event;
-use Gedcom::Record 1.08;
+use Gedcom::Record 1.09;
use vars qw($VERSION @ISA);
-$VERSION = "1.08";
+$VERSION = "1.09";
@ISA = qw( Gedcom::Record );
# sub type
@@ -45,7 +45,7 @@ __END__
Gedcom::Event - a module to manipulate Gedcom events
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
=head1 SYNOPSIS
View
10 Gedcom/Family.pm
@@ -1,9 +1,9 @@
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# documentation at __END__
@@ -13,10 +13,10 @@ require 5.005;
package Gedcom::Family;
-use Gedcom::Record 1.08;
+use Gedcom::Record 1.09;
use vars qw($VERSION @ISA);
-$VERSION = "1.08";
+$VERSION = "1.09";
@ISA = qw( Gedcom::Record );
sub husband
@@ -82,7 +82,7 @@ __END__
Gedcom::Family - a module to manipulate Gedcom families
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
=head1 SYNOPSIS
View
10 Gedcom/Grammar.pm
@@ -1,9 +1,9 @@
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# documentation at __END__
@@ -15,10 +15,10 @@ package Gedcom::Grammar;
use Data::Dumper;
-use Gedcom::Item 1.08;
+use Gedcom::Item 1.09;
use vars qw($VERSION @ISA);
-$VERSION = "1.08";
+$VERSION = "1.09";
@ISA = qw( Gedcom::Item );
sub structure
@@ -132,7 +132,7 @@ __END__
Gedcom::Grammar - a module to manipulate Gedcom grammars
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
=head1 SYNOPSIS
View
8 Gedcom/Grammar_5_5.pm
@@ -1,9 +1,9 @@
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# This file was automatically generated from gedcom-5.5.grammar
# by Paul Johnson
@@ -14,7 +14,7 @@
# Edit parse_grammar or Makefile.PL to increase the legibility of this file.
# (Removal of the leading spaces nearly halves the size of the file.)
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -23,7 +23,7 @@ require 5.005;
package Gedcom::Grammar_5_5;
use vars qw($VERSION $grammar);
-$VERSION = "1.08";
+$VERSION = "1.09";
$grammar = bless( {
level => -1,
View
11 Gedcom/Individual.pm
@@ -1,9 +1,9 @@
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# documentation at __END__
@@ -13,16 +13,17 @@ require 5.005;
package Gedcom::Individual;
-use Gedcom::Record 1.08;
+use Gedcom::Record 1.09;
use vars qw($VERSION @ISA);
-$VERSION = "1.08";
+$VERSION = "1.09";
@ISA = qw( Gedcom::Record );
sub name
{
my $self = shift;
my $name = $self->tag_value("NAME");
+ return "" unless defined $name;
$name =~ s/\s+/ /g;
$name =~ s| ?/ ?(.*?) ?/ ?| /$1/ |;
$name =~ s/^\s+//g;
@@ -293,7 +294,7 @@ __END__
Gedcom::Individual - a module to manipulate Gedcom individuals
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
=head1 SYNOPSIS
View
184 Gedcom/Item.pm
@@ -1,9 +1,9 @@
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# documentation at __END__
@@ -13,8 +13,10 @@ require 5.005;
package Gedcom::Item;
+use Symbol;
+
use vars qw($VERSION);
-$VERSION = "1.08";
+$VERSION = "1.09";
sub new
{
@@ -42,13 +44,15 @@ sub read
{
my $self = shift;
- $self->{fh} = FileHandle->new($self->{file})
- or die "Can't open file $self->{file}: $!";
+# $self->{fh} = FileHandle->new($self->{file})
+ $self->{fh} = gensym;
+ open($self->{fh}, $self->{file}) or die "Can't open file $self->{file}: $!";
+ binmode $self->{fh};
# find out how big the file is
- $self->{fh}->seek(0, 2);
- my $size = $self->{fh}->tell;
- $self->{fh}->seek(0, 0);
+ seek($self->{fh}, 0, 2);
+ my $size = tell;
+ seek($self->{fh}, 0, 0);
# initial callback
my $callback = $self->{callback};;
@@ -57,44 +61,111 @@ sub read
my $count = 0;
return undef
if $callback &&
- !$callback->($title, $txt1, "Record $count", $self->{fh}->tell, $size);
+ !$callback->($title, $txt1, "Record $count", tell, $size);
$self->level($self->{grammar} ? -1 : -2);
- # If we have a grammar, then we are reading a gedcom file and must use
- # the grammar to verify what is being read.
- # If we do not have a grammar, then that is what we are reading.
- while (my $item = $self->next_item($self))
+ my $if = "$self->{file}.index";
+ my ($gf, $gc);
+ if ($self->{gedcom}{read_only} &&
+ defined ($gf = -M $self->{file}) && defined ($gc = -M $if) && $gc < $gf)
{
- if ($self->{grammar})
+ if (! open I, $if)
+ {
+ die "Can't open $if: $!";
+ }
+ else
{
- my $tag = $item->{tag};
- if (my $g = $self->{grammar}->item($tag))
+ my $g = $self->{gedcom}{grammar}->structure("GEDCOM");
+ while (<I>)
{
- $self->parse($item, $g);
- push @{$self->{items}}, $item;
- $count++;
+ my @vals = split /\|/;
+ my $record =
+ Gedcom::Record->new(gedcom => $self->{gedcom},
+ tag => $vals[0],
+ line => $vals[2],
+ cpos => $vals[3],
+ grammar => $g->item($vals[0]),
+ fh => $self->{fh},
+ level => 0);
+ $record->{xref} = $vals[1] if length $vals[1];
+ my $class = $self->{gedcom}{types}{$vals[0]};
+ bless $record, "Gedcom::$class" if $class;
+ push @{$self->{items}}, $record;
+ }
+ close I or warn "Can't close $if";
+ }
+ # use Data::Dumper;
+ # print Dumper $self;
+ }
+
+ unless ($self->{items})
+ {
+ # use Data::Dumper;
+ # print Dumper $self->{items};
+ # $#{$self->{items}} = 20000;
+ # $#{$self->{items}} = -1;
+ # If we have a grammar, then we are reading a gedcom file and must use
+ # the grammar to verify what is being read.
+ # If we do not have a grammar, then that is what we are reading.
+ while (my $item = $self->next_item($self))
+ {
+ if ($self->{grammar})
+ {
+ my $tag = $item->{tag};
+ if (my $g = $self->{grammar}->item($tag))
+ {
+ $self->parse($item, $g);
+ push @{$self->{items}}, $item;
+ $count++;
+ }
+ else
+ {
+ $tag = "<empty tag>" unless defined $tag && length $tag;
+ warn "$self->{file}:$item->{line}: $tag is not a top level tag\n";
+ }
}
else
{
- $tag = "<empty tag>" unless defined $tag && length $tag;
- warn "$self->{file}:$item->{line}: $tag is not a top level tag\n";
+ # just add the grammar item
+ push @{$self->{items}}, $item;
+ $count++;
}
+ return undef
+ if ref $item &&
+ $callback &&
+ !$callback->($title, $txt1, "Record $count line " . $item->{line},
+ tell, $size);
+ }
+ }
+
+# unless ($self->{gedcom}{read_only})
+# {
+# $self->{fh}->close or die "Can't close file $self->{file}: $!";
+# delete $self->{fh};
+# }
+
+ if ($self->{gedcom}{read_only} && defined $gf && (! defined $gc || $gc > $gf))
+ {
+ # print Dumper $self;
+ # $self->{gedcom}->individuals;
+ if (! open I, ">$if")
+ {
+ warn "Can't open $if";
}
else
{
- # just add the grammar item
- push @{$self->{items}}, $item;
- $count++;
+ for my $item (@{$self->{items}})
+ {
+ print I join("|", map { $item->{$_} || "" } qw(tag xref line cpos));
+ # my $n = $item->tag_value("NAME");
+ # print I "|$n" if defined $n;
+ print I "\n";
+ }
+ close I or warn "Can't close $if";
}
- return undef
- if ref $item &&
- $callback &&
- !$callback->($title, $txt1, "Record $count line " . $item->{line},
- $self->{fh}->tell, $size);
}
-# $self->{fh}->close or die "Can't close file $self->{file}: $!";
-# delete $self->{fh};
+
$self;
}
@@ -118,7 +189,8 @@ sub add_items
# print "reading items\n";
if (defined $item->{cpos})
{
- $self->{fh}->seek($item->{cpos}, 0);
+ seek($self->{fh}, $item->{cpos}, 0);
+ $. = $item->{line};
}
}
$item->{items} = [];
@@ -155,9 +227,10 @@ sub skip_items
my $self = shift;
my ($item) = @_;
my $level = $item->{level};
- my $cpos = $item->{cpos} = $self->{fh}->tell;
+ my $cpos = $item->{cpos} = tell;
# print "skipping items to level $level at $item->{line}:$cpos\n";
- while (my $l = $self->next_text_line)
+ my $fh = $self->{fh};
+ while (my $l = <$fh>)
{
chomp $l;
# print "parsing <$l>\n";
@@ -166,11 +239,12 @@ sub skip_items
if ($lev <= $level)
{
# print "pushing <$l>\n";
- $self->{fh}->seek($cpos, 0);
+ seek($self->{fh}, $cpos, 0);
+ $.--;
last;
}
}
- $cpos = $self->{fh}->tell;
+ $cpos = tell;
}
}
@@ -178,8 +252,10 @@ sub next_item
{
my $self = shift;
my ($item) = @_;
- my $bpos = $self->{fh}->tell;
+ my $bpos = tell;
+ # print "At $bpos\n";
my $rec;
+ my $fh = $self->{fh};
if ($rec = $self->{stored_item})
{
$self->{stored_item} = undef;
@@ -187,8 +263,8 @@ sub next_item
elsif ((!$rec || !$rec->{level}) && (my $line = $self->next_text_line))
{
# TODO - tidy this up
-# print "line is $line";
- my $line_number = eval { $self->{fh}->input_line_number } || $.;
+ # print "line is <$line>";
+ my $line_number = $.;
if (my ($structure) = $line =~ /^\s*(\w+): =\s*$/)
{
$rec = $self->new(level => -1,
@@ -234,8 +310,22 @@ sub next_item
)? # optional
\*? # optional *
\s*$/x) # optional whitespace at end
+# $line =~ /^\s* # optional whitespace at start
+# (\d+) # start level
+# \s* # optional whitespace
+# (?: # xref
+# (@.*@) # text in @@
+# \s+ # whitespace
+# )? # optional
+# (\w+) # tag
+# \s* # whitespace
+# (?: # value
+# (@?.*?@?) # text element - non greedy
+# \s+ # whitespace
+# )?? # optional - non greedy
+# \s*$/x) # optional whitespace at end
{
-# print "found $level below $item->{level}\n";
+ # print "found $level below $item->{level}\n";
if ($level eq "n" || $level > $item->{level})
{
unless ($rec)
@@ -254,8 +344,9 @@ sub next_item
}
else
{
-# print " -- pushing back\n";
- $self->{fh}->seek($bpos, 0);
+ # print " -- pushing back\n";
+ seek($fh, $bpos, 0);
+ $.--;
}
}
elsif ($line =~ /^\s*[\[\|\]]\s*(?:\/\*.*\*\/\s*)?$/)
@@ -284,7 +375,8 @@ sub next_item
sub next_line
{
my $self = shift;
- my $line = $self->{fh}->getline;
+ my $fh = $self->{fh};
+ my $line = <$fh>;
# print "read $line";
$line;
}
@@ -293,7 +385,9 @@ sub next_text_line
{
my $self = shift;
my $line = "";
- $line = $self->next_line until !defined $line || $line =~ /\S/;
+# $line = $self->next_line until !defined $line || $line =~ /\S/;
+ my $fh = $self->{fh};
+ $line = <$fh> until !defined $line || $line =~ /\S/;
$line;
}
@@ -488,7 +582,7 @@ __END__
Gedcom::Item - a base class for Gedcom::Grammar and Gedcom::Record
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
=head1 SYNOPSIS
View
10 Gedcom/LifeLines.pm
@@ -1,9 +1,9 @@
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# documentation at __END__
@@ -20,10 +20,10 @@ BEGIN
eval "use Roman ()";
}
-use Gedcom 1.08;
+use Gedcom 1.09;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = "1.08";
+$VERSION = "1.09";
@ISA = qw( Exporter );
@EXPORT = qw
(
@@ -1226,7 +1226,7 @@ __END__
Gedcom::LifeLines - functions for lines2perl
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
=head1 SYNOPSIS
View
22 Gedcom/Record.pm
@@ -1,9 +1,9 @@
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# documentation at __END__
@@ -16,10 +16,10 @@ package Gedcom::Record;
use Carp;
BEGIN { eval "use Date::Manip" } # We'll use this if it is available
-use Gedcom::Item 1.08;
+use Gedcom::Item 1.09;
use vars qw($VERSION @ISA $AUTOLOAD);
-$VERSION = "1.08";
+$VERSION = "1.09";
@ISA = qw( Gedcom::Item );
my %Funcs;
@@ -90,7 +90,12 @@ sub record
: "Record type not specified";
$record = $func;
}
+
@records = map { $_->tag_record($record, $count) } @records;
+
+ # fams and famc need to be resolved
+ @records = map { $self->resolve($_->{value}) } @records
+ if $record eq "FAMS" || $record eq "FAMC";
}
wantarray ? @records : $records[0]
}
@@ -159,9 +164,9 @@ sub parse
}
else
{
- print "Valid sub-items are ",
- join(", ", keys %{$grammar->{_valid_items}}), "\n";
- warn "$self->{file}:$r->{line}: $tag is not a sub-item of $t\n"
+ warn "$self->{file}:$r->{line}: $tag is not a sub-item of $t\n",
+ "Valid sub-items are ",
+ join(", ", keys %{$grammar->{_valid_items}}), "\n"
unless substr($tag, 0, 1) eq "_";
# unless $tag eq "CONT" || $tag eq "CONC" || substr($tag, 0, 1) eq "_";
# TODO - should CONT and CONC be allowed anywhere?
@@ -423,7 +428,7 @@ __END__
Gedcom::Record - a module to manipulate Gedcom records
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
=head1 SYNOPSIS
@@ -676,6 +681,7 @@ sub validate_grammar
}
else
{
+ # TODO - require Data::Dumper
die "What's a " . Data::Dumper->new([$grammar], ["grammar"])
unless ($value) = $grammar->{value} =~ /<<(.*)>>/;
die "Can't find $value in gedcom structures"
View
3  MANIFEST
@@ -16,7 +16,9 @@ Gedcom/Family.pm
Gedcom/Event.pm
Gedcom/Grammar_5_5.pm
Gedcom/LifeLines.pm
+Gedcom/CGI.pm
gedcom-5.5.grammar
+cgi-bin/gedcom.cgi
t/Engine.pm
t/Basic.pm
t/basic.t
@@ -40,3 +42,4 @@ t/lines/namefreq.l
t/lines/namefreq.plx
royal.ged
gedcom.vim
+session.vim
View
114 Makefile.PL
@@ -1,11 +1,11 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
use strict;
@@ -15,22 +15,34 @@ use ExtUtils::MakeMaker;
$| = 1;
-my $Version = "1.08";
-my $Date = "8th May 2000";
+my $Version = "1.09";
+my $Date = "12th February 2001";
+my $Author = 'pjcj@cpan.org';
+
+my @perlbug = ("perlbug", "-a", $Author,
+ "-s", "Installation of Gedcom $Version");
+
+my $Perlbug = join " ", map { / / ? "'$_'" : $_ } @perlbug;
+
open(M, "MANIFEST") or die "Cannot open MANIFEST: $!";
my @files = map { split } <M>;
my @versions = grep { $_ ne "README" && $_ ne "Makefile.PL" } @files;
close(M) or die "Cannot close MANIFEST: $!";
+$ExtUtils::MakeMaker::Verbose = 0;
+
WriteMakefile
(
- NAME => "Gedcom",
- VERSION => $Version,
- DIR => [],
- dist => { COMPRESS => "gzip --best --force" },
- clean => { FILES => join " ", map { "$_.version" } @versions },
- depend => { distdir => "@files" },
+ NAME => "Gedcom",
+ VERSION => $Version,
+ AUTHOR => 'Paul Johnson (pjcj@cpan.org)',
+ ABSTRACT => "Interface to genealogy GEDCOM files",
+ DIR => [],
+ PM => { map {($_ => '$(INST_LIBDIR)/' . $_)} grep { /\.pm/ } @files },
+ dist => { COMPRESS => "gzip --best --force" },
+ clean => { FILES => join " ", map { "$_.version" } @versions },
+ depend => { distdir => "@files" },
);
print "\n";
@@ -141,7 +153,22 @@ else
print "working\n";
}
-print "\n";
+print <<EOM;
+
+--------------------------------------------------------------------------------
+
+I like to have some idea of the distribution of this software. To that end I
+would be very grateful for mail from you. This will be used only to satisfy my
+curiosity and to help me make decisions which may involve changes to the
+module.
+
+If you can run perlbug you can send me a success report with "make ok".
+Failure reports with "make nok" are also appreciated.
+
+If you have any questions or comments, mailing list details are available in the
+README file, or send mail to me directly.
+
+EOM
sub MY::postamble
{
@@ -167,59 +194,20 @@ README : Gedcom.pm
-e 'print if (/NAME/ ... /^[A-Z ]+\$\$/) =~ /^\\d+\$\$/;' \\
-e 'print if (/DESCRIPTION/ ... /^[A-Z ]+\$\$/) =~ /^\\d+\$\$/;' \\
> README
- ]
-}
-my $author = 'pjcj@cpan.org';
+ppm : ppd pure_all
+\t tar cf Gedcom.tar blib
+\t gzip --best --force Gedcom.tar
+\t \$(PERL) -pi.bak \\
+ -e 's/(OS NAME=")[^"]*/\$\$1MSWin32/;' \\
+ -e 's/(ARCHITECTURE NAME=")[^"]*/\$\$1MSWin32-x86-multi-thread/;' \\
+ -e 's/(CODEBASE HREF=")[^"]*/\$\$1Gedcom.tar.gz/;' \\
+ Gedcom.ppd
-my @command = ("perlbug", "-a", $author,
- "-s", "Installation of Gedcom $Version",
- "-okay");
+ok :
+\t \@$Perlbug -okay || echo "Please send your report manually to $Author"
-my $command = join " ", map { / / ? "'$_'" : $_ } @command;
-
-my $message = <<EOM;
-I like to have some idea of the distribution of this software. To that end I
-would be very grateful for mail from you. This will be used only to satisfy my
-curiosity and to help me make decisions which may involve changes to the
-interface etc.
-
-The command: $command
-will provide all the information I need.
-
-EOM
-
-print $message;
-
-if (-t STDIN)
-{
- my $mess = <<EOM;
-May I send a message to the author, Paul Johnson ($author), using the
-above command, to indicate that you are using this module? yes or no [yes]
-EOM
-
- chomp $mess;
- print $mess;
- my $rep = <STDIN>;
- if ($rep =~ /^n/)
- {
- print <<EOM;
-
-If you are able to send a message in the future, please do so with the command:
-$command
-
-EOM
- }
- else
- {
- system @command;
- print "\n$command failed: status $?\n\nPlease send a message manually\n\n"
- if $?;
- }
+nok :
+\t \@$Perlbug -nokay || echo "Please send your report manually to $Author"
+ ]
}
-
-print <<EOM;
-If you have any questions or comments, mailing list details are available in the
-README file, or send mail to me directly.
-
-EOM
View
6 README
@@ -1,16 +1,16 @@
NAME
Gedcom - a module to manipulate Gedcom genealogy files
- Version 1.08 - 8th May 2000
+ Version 1.09 - 12th February 2001
DESCRIPTION
- Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+ Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
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.fsnet.co.uk
+ homepage: http://www.pjcj.net
This module provides for manipulation of Gedcom files. Gedcom is a
format for storing genealogical information designed by The Church of
View
48 cgi-bin/gedcom.cgi
@@ -0,0 +1,48 @@
+#!/usr/local/bin/perl -w
+
+# Copyright 2001, Paul Johnson (pjcj@cpan.org)
+
+# 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.09 - 12th February 2001
+
+use strict;
+
+require 5.005;
+
+use lib "/home/pjcj/ged/latest";
+
+use CGI qw(:cgi :html);
+
+use Gedcom::CGI 1.09;
+
+my $op = param("op");
+
+eval { Gedcom::CGI->$op() };
+
+if (my $error = $@)
+{
+ print header,
+ start_html,
+ h1("Gedcom error"),
+ "Unable to run $op.",
+ pre($error),
+ end_html;
+}
+
+__END__
+
+=head1 NAME
+
+main.cgi
+
+Version 1.09 - 12th February 2001
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=cut
View
22 ged
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -18,10 +18,10 @@ use diagnostics;
use Data::Dumper;
$Data::Dumper::Indent = 1;
-use Gedcom 1.08;
+use Gedcom 1.09;
use vars qw( $VERSION );
-$VERSION = "1.08";
+$VERSION = "1.09";
eval "use Date::Manip";
Date_Init("DateFormat=UK") if $INC{"Date/Manip.pm"};
@@ -36,11 +36,19 @@ sub main()
my $ged = Gedcom->new
(
gedcom_file => $gedcom_file,
- grammar_version => 0.1,
+# grammar_version => 0.1,
# grammar_file => "gedcom-5.5.grammar",
callback => sub { print "." },
- read_only => 0,
+ read_only => 1,
);
+ if (1)
+ {
+ my $i = $ged->get_individual("helena");
+ print "\n", $i->xref, " => ", $i->name, "\n";
+ system "ps -o user,pid,pgid,pcpu,pmem,vsz,rss,tty,s,stime,time,args " .
+ "| grep ged";
+ return;
+ }
# print Dumper $ged;
# print "\nnormalising dates...";
# $ged->normalise_dates("%E %b %Y");
View
2  gedcom.vim
@@ -1,7 +1,7 @@
" Vim syntax file
" Language: Gedcom
" Maintainer: Paul Johnson (pjcj@cpan.org)
-" Version 1.08 - 8th May 2000
+" Version 1.09 - 12th February 2001
syntax clear
View
26 lines2perl
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -23,11 +23,11 @@ use lib $FindBin::Bin;
use Parse::RecDescent;
-use Gedcom 1.08;
-use Gedcom::LifeLines 1.08;
+use Gedcom 1.09;
+use Gedcom::LifeLines 1.09;
use vars qw( $VERSION $Prefix $Suffix);
-$VERSION = "1.08";
+$VERSION = "1.09";
sub _indent
{
@@ -58,13 +58,13 @@ $Prefix = <<'EOH';
#!/usr/local/bin/perl -w
# This program was generated by lines2perl, which is part of Gedcom.pm.
-# Gedcom.pm is Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
-# Version 1.08 - 8th May 2000
+# Gedcom.pm is Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
+# Version 1.09 - 12th February 2001
# Gedcom.pm is free. It is licensed under the same terms as Perl itself.
# The latest version of Gedcom.pm should be available from my homepage:
-# http://www.pjcj.fsnet.co.uk
+# http://www.pjcj.net
use strict;
@@ -75,7 +75,7 @@ use integer;
use Getopt::Long;
-use Gedcom::LifeLines 1.08;
+use Gedcom::LifeLines 1.09;
my $Ged; # Gedcom object
my %Opts; # options
@@ -303,8 +303,8 @@ forlist_statement : "forlist" "(" name "," scalar "," scalar ")"
"}\n"
}
-spouses_statement : "spouses" "(" scalar "," scalar "," scalar "," scalar ")"
- "{" statements "}"
+spouses_statement : "spouses" "(" expression ","
+ scalar "," scalar "," scalar ")" "{" statements "}"
{
# warn "item is ", ::Dumper \@item;
"$item[9] = 0;\n" .
@@ -321,7 +321,7 @@ spouses_statement : "spouses" "(" scalar "," scalar "," scalar "," scalar ")"
}
families_statement : "families"
- "(" scalar "," scalar "," scalar "," scalar ")"
+ "(" expression "," scalar "," scalar "," scalar ")"
"{" statements "}"
{
# warn "item is ", ::Dumper \@item;
View
14 parse_grammar
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -15,10 +15,10 @@ require 5.005;
use Data::Dumper;
-use Gedcom 1.08;
+use Gedcom 1.09;
use vars qw( $VERSION );
-$VERSION = "1.08";
+$VERSION = "1.09";
$SIG{__WARN__} = sub { print "\n@_" };
@@ -53,12 +53,12 @@ sub main()
open(G, ">$gpm") or die "Can't open $gpm: $!";
print G <<EOT;
-# Copyright 1998-2000, Paul Johnson (pjcj\@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj\@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
# This file was automatically generated from $grammar_file
# by $me
View
2  royal.ged
@@ -9,7 +9,7 @@
2 FORM LINEAGE-LINKED
1 SUBM @S1@
1 NOTE This Gedcom file should only be used as part of the testsuite
-2 CONC for Gedcom.pm (http://www.pjcj.fsnet.co.uk). I have removed a
+2 CONC for Gedcom.pm (http://www.pjcj.net). I have removed a
2 CONC lot of data from the original, and changed a few bits, so you
2 CONC should use the original if you want royal genealogy. Contact me
2 CONC if you cannot locate the original.
View
21 session.vim
@@ -0,0 +1,21 @@
+1,999bd
+e Gedcom.pm
+e Gedcom/Item.pm
+e Gedcom/Grammar.pm
+e Gedcom/Record.pm
+e Gedcom/Individual.pm
+e Gedcom/Family.pm
+e Gedcom/Event.pm
+e Gedcom/CGI.pm
+e Gedcom/LifeLines.pm
+e Makefile.PL
+e CHANGES
+e TODO
+e MANIFEST
+e parse_grammar
+e lines2perl
+e gedcom-5.5.grammar
+e t/Basic.pm
+e ged
+e tkged
+e #1
View
12 t/Basic.pm
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -16,11 +16,11 @@ require 5.005;
package Basic;
use vars qw($VERSION);
-$VERSION = "1.08";
+$VERSION = "1.09";
use Test;
-use Gedcom 1.08;
+use Gedcom 1.09;
eval "use Date::Manip";
Date_Init("DateFormat=UK") if $INC{"Date/Manip.pm"};
@@ -272,7 +272,7 @@ __DATA__
2 FORM LINEAGE-LINKED
1 SUBM @S1@
1 NOTE This Gedcom file should only be used as part of the testsuite
-2 CONC for Gedcom.pm (http://www.pjcj.fsnet.co.uk). I have removed a
+2 CONC for Gedcom.pm (http://www.pjcj.net). I have removed a
2 CONC lot of data from the original, and changed a few bits, so you
2 CONC should use the original if you want royal genealogy. Contact me
2 CONC if you cannot locate the original.
View
10 t/Engine.pm
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -16,9 +16,9 @@ require 5.005;
package Engine;
use vars qw($VERSION);
-$VERSION = "1.08";
+$VERSION = "1.09";
-use Gedcom 1.08;
+use Gedcom 1.09;
sub test
{
View
19 t/Lines.pm
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -19,9 +19,9 @@ use File::Basename;
use Test;
use vars qw($VERSION);
-$VERSION = "1.08";
+$VERSION = "1.09";
-use Gedcom 1.08;
+use Gedcom 1.09;
sub test
{
@@ -35,6 +35,7 @@ sub test
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"
@@ -71,10 +72,10 @@ sub test
$args{perl_report} = "$args{report}.p" unless defined $args{perl_report};
die "perl_command not specified" unless defined $args{perl_command};
- open(P, "|$^X " . (-d "t" ? "" : "-I .. ") .
- "$args{perl_program} -quiet -gedcom_file $args{gedcom_file}" .
- "> $args{perl_report}")
- or die "Can't run <$^X $args{perl_program}>";
+ 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};
View
6 t/basic.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
View
10 t/bias.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -15,7 +15,9 @@ use lib -d "t" ? "t" : "..";
use Lines;
-my $report = (-d "t" ? "t/" : "") . "lines/bias";
+use File::Spec;
+
+my $report = File::Spec->catfile((-d "t" ? ("t/") : ()), "lines", "bias");
Lines->test(tests => 36,
report => $report,
View
8 t/birthdates.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -19,7 +19,7 @@ BEGIN { plan tests => 161 }
use lib -d "t" ? "t" : "..";
-use Gedcom 1.08;
+use Gedcom 1.09;
use Engine;
my $Test = sub
View
10 t/lines.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
# This is really just a test of the lifelines testing mechanism, but it
# also serves as a very basic lifelines test.
@@ -18,7 +18,9 @@ use lib -d "t" ? "t" : "..";
use Lines;
-my $report = (-d "t" ? "t/" : "") . "lines/lines";
+use File::Spec;
+
+my $report = File::Spec->catfile((-d "t" ? ("t/") : ()), "lines", "lines");
Lines->test(tests => 9,
report => $report,
View
4 t/lines/bias
@@ -3,8 +3,8 @@ bias
Compute sex bias based on previous births
-Version 1.08 - 8th May 2000
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
+Version 1.09 - 12th February 2001
Ever notice that certain families seem to have all boys or all girls?
Sometimes five or six in a row of all the same sex? Is this a mere
View
16 t/lines/bias.plx
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
# This program was generated by lines2perl, which is part of Gedcom.pm.
-# Gedcom.pm is Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
-# Version 1.08 - 8th May 2000
+# Gedcom.pm is Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
+# Version 1.09 - 12th February 2001
# Gedcom.pm is free. It is licensed under the same terms as Perl itself.
# The latest version of Gedcom.pm should be available from my homepage:
-# http://www.pjcj.fsnet.co.uk
+# http://www.pjcj.net
use strict;
@@ -18,7 +18,7 @@ use integer;
use Getopt::Long;
-use Gedcom::LifeLines 1.08;
+use Gedcom::LifeLines 1.09;
my $Ged; # Gedcom object
my %Opts; # options
@@ -64,8 +64,8 @@ $SIG{__WARN__} = sub
#
# Compute sex bias based on previous births
#
-# Version 1.08 - 8th May 2000
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
+# Version 1.09 - 12th February 2001
#
# Ever notice that certain families seem to have all boys or all girls?
# Sometimes five or six in a row of all the same sex? Is this a mere
@@ -458,8 +458,8 @@ bias
Compute sex bias based on previous births
-Version 1.08 - 8th May 2000
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
+Version 1.09 - 12th February 2001
Ever notice that certain families seem to have all boys or all girls?
Sometimes five or six in a row of all the same sex? Is this a mere
View
8 t/lines/lines.plx
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
# This program was generated by lines2perl, which is part of Gedcom.pm.
-# Gedcom.pm is Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
-# Version 1.08 - 8th May 2000
+# Gedcom.pm is Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
+# Version 1.09 - 12th February 2001
# Gedcom.pm is free. It is licensed under the same terms as Perl itself.
# The latest version of Gedcom.pm should be available from my homepage:
-# http://www.pjcj.fsnet.co.uk
+# http://www.pjcj.net
use strict;
@@ -18,7 +18,7 @@ use integer;
use Getopt::Long;
-use Gedcom::LifeLines 1.08;
+use Gedcom::LifeLines 1.09;
my $Ged; # Gedcom object
my %Opts; # options
View
8 t/lines/namefreq.plx
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
# This program was generated by lines2perl, which is part of Gedcom.pm.
-# Gedcom.pm is Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
-# Version 1.08 - 8th May 2000
+# Gedcom.pm is Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
+# Version 1.09 - 12th February 2001
# Gedcom.pm is free. It is licensed under the same terms as Perl itself.
# The latest version of Gedcom.pm should be available from my homepage:
-# http://www.pjcj.fsnet.co.uk
+# http://www.pjcj.net
use strict;
@@ -18,7 +18,7 @@ use integer;
use Getopt::Long;
-use Gedcom::LifeLines 1.08;
+use Gedcom::LifeLines 1.09;
my $Ged; # Gedcom object
my %Opts; # options
View
10 t/namefreq.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
# This is really just a test of the lifelines testing mechanism, but it
# also serves as a very basic lifelines test.
@@ -18,7 +18,9 @@ use lib -d "t" ? "t" : "..";
use Lines;
-my $report = (-d "t" ? "t/" : "") . "lines/namefreq";
+use File::Spec;
+
+my $report = File::Spec->catfile((-d "t" ? ("t/") : ()), "lines", "namefreq");
Lines->test(tests => 82,
report => $report,
View
4 t/parse_grammar.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.transeda.com/pjcj
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
View
6 t/read_only.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
View
6 t/resolve.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
View
6 t/resolve_read_only.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
View
12 tkged
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2000, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2001, Paul Johnson (pjcj@cpan.org)
# 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.fsnet.co.uk
+# http://www.pjcj.net
-# Version 1.08 - 8th May 2000
+# Version 1.09 - 12th February 2001
use strict;
@@ -24,10 +24,10 @@ use Tk;
use Carp;
use Data::Dumper;
-use Gedcom 1.08;
+use Gedcom 1.09;
use vars qw( $VERSION );
-$VERSION = "1.08";
+$VERSION = "1.09";
eval "use Date::Manip";
Date_Init("DateFormat=UK") if $INC{"Date/Manip.pm"};
@@ -1236,7 +1236,7 @@ __END__
tkged - an interactive program to manipulate Gedcom genealogy files
-Version 1.08 - 8th May 2000
+Version 1.09 - 12th February 2001
=head1 SYNOPSIS
Please sign in to comment.
Something went wrong with that request. Please try again.