Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Version 1.12

  • Loading branch information...
commit aca2178b9184d92bc0caf8e0e8482e22811a3faa 1 parent e9aa8a7
@pjcj authored
Showing with 2,768 additions and 2,633 deletions.
  1. +5 −0 CHANGES
  2. +17 −15 Gedcom.pm
  3. +5 −5 Gedcom/CGI.pm
  4. +4 −4 Gedcom/Event.pm
  5. +7 −4 Gedcom/Family.pm
  6. +4 −4 Gedcom/Grammar.pm
  7. +2,475 −2,475 Gedcom/Grammar_5_5.pm
  8. +4 −4 Gedcom/Individual.pm
  9. +56 −18 Gedcom/Item.pm
  10. +4 −4 Gedcom/LifeLines.pm
  11. +4 −4 Gedcom/Record.pm
  12. +1 −0  MANIFEST
  13. +10 −3 Makefile.PL
  14. +2 −2 README
  15. +2 −0  TODO
  16. +6 −6 cgi-bin/gedcom.cgi
  17. +15 −10 ged
  18. +1 −1  gedcom.vim
  19. +50 −10 lines2perl
  20. +5 −5 parse_grammar
  21. +14 −7 t/Basic.pm
  22. +4 −4 t/Engine.pm
  23. +4 −4 t/Lines.pm
  24. +2 −2 t/basic.t
  25. +2 −2 t/bias.t
  26. +12 −5 t/birthdates.t
  27. +6 −6 t/ged_create.t
  28. +18 −0 t/grammar_file.t
  29. +2 −2 t/lines.t
  30. +1 −1  t/lines/bias
  31. +5 −5 t/lines/bias.plx
  32. +3 −3 t/lines/lines.plx
  33. +3 −3 t/lines/namefreq.plx
  34. +2 −2 t/namefreq.t
  35. +2 −2 t/parse_grammar.t
  36. +2 −2 t/read_only.t
  37. +2 −2 t/resolve.t
  38. +2 −2 t/resolve_read_only.t
  39. +5 −5 tkged
View
5 CHANGES
@@ -219,3 +219,8 @@ Release 1.10 - 5th March 2002
Release 1.11 - 7th April 2002
- Improvements to the algorithm in Gedcom::Grammar::item().
+
+Release 1.12 - 2nd February 2003
+ - Ignore CRLF differences in tests.
+ - Tighten up and improve XML output.
+ - Add some missing functions to lines2perl (John S. Quarterman).
View
32 Gedcom.pm
@@ -1,4 +1,4 @@
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -26,7 +26,7 @@ my %Top_tag_order;
BEGIN
{
- $VERSION = "1.11";
+ $VERSION = "1.12";
$Tags =
{
@@ -216,10 +216,10 @@ sub AUTOLOAD
goto &$func
}
-use Gedcom::Grammar 1.11;
-use Gedcom::Individual 1.11;
-use Gedcom::Family 1.11;
-use Gedcom::Event 1.11;
+use Gedcom::Grammar 1.12;
+use Gedcom::Individual 1.12;
+use Gedcom::Family 1.12;
+use Gedcom::Event 1.12;
sub new
{
@@ -318,12 +318,12 @@ sub new
$l2->add("ADDR", "http://www.pjcj.net");
$l2 = $l1->add("DATA");
$l3 = $l2->add("COPR",
- 'Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)');
+ 'Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)');
$l1 = $l0->add("NOTE", "");
for (split /\n/, <<'EOH')
This output was generated by Gedcom.pm.
-Gedcom.pm is Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
-Version 1.11 - 7th April 2002
+Gedcom.pm is Copyright 1999-2003, Paul Johnson (pjcj@cpan.org)
+Version 1.12 - 2nd February 2003
Gedcom.pm is free. It is licensed under the same terms as Perl itself.
@@ -371,11 +371,13 @@ sub write_xml
my $file = shift or die "No filename specified";
$self->{fh} = FileHandle->new($file, "w") or die "Can't open $file: $!";
$self->{fh}->print(<<'EOH');
+<?xml version="1.0" encoding="utf-8"?>
+
<!--
This output was generated by Gedcom.pm.
-Gedcom.pm is Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
-Version 1.11 - 7th April 2002
+Gedcom.pm is Copyright 1999-2003, Paul Johnson (pjcj@cpan.org)
+Version 1.12 - 2nd February 2003
Gedcom.pm is free. It is licensed under the same terms as Perl itself.
@@ -634,7 +636,7 @@ __END__
Gedcom - a module to manipulate Gedcom genealogy files
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
@@ -667,7 +669,7 @@ Version 1.11 - 7th April 2002
=head1 DESCRIPTION
-Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
This software is free. It is licensed under the same terms as Perl itself.
@@ -857,8 +859,8 @@ DECstation, and partly because of laziness again. I'm not too sure
whether this is good or bad laziness yet. Time will tell no doubt.
As of version 1.05, you should be able to access all the data through
-functions. Well, read access anyway. The TODO list mentions something
-about improving the situation as far as write access is concerned.
+functions, and as of version 1.10 write access is available. I have a
+faster machine now.
Some of the more important hash members are:
View
10 Gedcom/CGI.pm
@@ -1,4 +1,4 @@
-# Copyright 2001-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 2001-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -15,15 +15,15 @@ package Gedcom::CGI;
use CGI qw(:cgi :html);
-use Gedcom 1.11;
+use Gedcom 1.12;
use vars qw($VERSION);
-$VERSION = "1.11";
+$VERSION = "1.12";
sub gedcom
{
my ($gedcom_file) = @_;
- $gedcom_file = "/home/pjcj/ged/latest/$gedcom_file.ged";
+ $gedcom_file = "/home/pjcj/g/perl/dev/Gedcom/$gedcom_file.ged";
Gedcom->new(gedcom_file => $gedcom_file,
read_only => 1);
}
@@ -142,7 +142,7 @@ __END__
Gedcom::CGI - Basic CGI routines for Gedcom.pm
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
View
8 Gedcom/Event.pm
@@ -1,4 +1,4 @@
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -13,10 +13,10 @@ require 5.005;
package Gedcom::Event;
-use Gedcom::Record 1.11;
+use Gedcom::Record 1.12;
use vars qw($VERSION @ISA);
-$VERSION = "1.11";
+$VERSION = "1.12";
@ISA = qw( Gedcom::Record );
# sub type
@@ -45,7 +45,7 @@ __END__
Gedcom::Event - a module to manipulate Gedcom events
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
View
11 Gedcom/Family.pm
@@ -1,4 +1,4 @@
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -13,10 +13,10 @@ require 5.005;
package Gedcom::Family;
-use Gedcom::Record 1.11;
+use Gedcom::Record 1.12;
use vars qw($VERSION @ISA);
-$VERSION = "1.11";
+$VERSION = "1.12";
@ISA = qw( Gedcom::Record );
sub husband
@@ -112,7 +112,7 @@ __END__
Gedcom::Family - a module to manipulate Gedcom families
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
@@ -125,6 +125,9 @@ Version 1.11 - 7th April 2002
my @rel = $f->children;
my @rel = $f->boys;
my @rel = $f->girls;
+ $f->add_husband($i);
+ $f->add_wife($i);
+ $f->add_child($i);
=head1 DESCRIPTION
View
8 Gedcom/Grammar.pm
@@ -1,4 +1,4 @@
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -15,10 +15,10 @@ package Gedcom::Grammar;
use Data::Dumper;
-use Gedcom::Item 1.11;
+use Gedcom::Item 1.12;
use vars qw($VERSION @ISA);
-$VERSION = "1.11";
+$VERSION = "1.12";
@ISA = qw( Gedcom::Item );
sub structure
@@ -138,7 +138,7 @@ __END__
Gedcom::Grammar - a module to manipulate Gedcom grammars
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
View
4,950 Gedcom/Grammar_5_5.pm
2,475 additions, 2,475 deletions not shown
View
8 Gedcom/Individual.pm
@@ -1,4 +1,4 @@
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -13,10 +13,10 @@ require 5.005;
package Gedcom::Individual;
-use Gedcom::Record 1.11;
+use Gedcom::Record 1.12;
use vars qw($VERSION @ISA);
-$VERSION = "1.11";
+$VERSION = "1.12";
@ISA = qw( Gedcom::Record );
sub name
@@ -301,7 +301,7 @@ __END__
Gedcom::Individual - a module to manipulate Gedcom individuals
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
View
74 Gedcom/Item.pm
@@ -1,4 +1,4 @@
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -16,7 +16,7 @@ package Gedcom::Item;
use Symbol;
use vars qw($VERSION);
-$VERSION = "1.11";
+$VERSION = "1.12";
sub new
{
@@ -433,49 +433,84 @@ sub write_xml
{
my $self = shift;
my ($fh, $level) = @_;
+
+ return if $self->{tag} && $self->{tag} =~ /^(CON[CT]|TRLR)$/;
+
+ my $spaced = 0;
+ my $events = 0;
+
$level = 0 unless $level;
my $indent = " " x $level;
- my $tag = $level >= 0 && $self->{tag} && $self->{tag} !~ /^CON[CT]$/;
+
+ my $tag = $level >= 0 && $self->{tag};
+
my $value = $self->{value}
? ref $self->{value}
- ? "$self->{value}{xref}"
- : $self->resolve_xref($self->{value})
- ? "$self->{value}"
- : $self->{value}
+ ? $self->{value}{xref}
+ : $self->full_value
: undef;
+ $value =~ s/\s+$// if defined $value;
+
+ my $sub_items = @{$self->_items};
+
my $p = "";
if ($tag)
{
- $tag = defined $self->{gedcom}{types}{$self->{tag}} &&
+ $tag = $events &&
+ defined $self->{gedcom}{types}{$self->{tag}} &&
$self->{gedcom}{types}{$self->{tag}} eq "Event"
? "EVEN"
: $self->{tag};
+
+ $tag = "GED" if $tag eq "GEDCOM";
+
$p .= $indent;
$p .= "<$tag";
+
if ($tag eq "EVEN")
{
$p .= qq( EV="$self->{tag}");
}
- elsif ($tag =~ /^(FAM[SC]|SUBM|NOTE|HUSB|WIFE|CHIL)$/)
+ elsif ($tag =~ /^(FAM[SC]|HUSB|WIFE|CHIL|SUBM|NOTE)$/ &&
+ defined $value &&
+ $self->resolve_xref($self->{value}))
{
- $p .= qq( REF="$value") if defined $value;
+ $p .= qq( REF="$value");
$value = undef;
- $tag = undef unless @{$self->_items};
+ $tag = undef unless $sub_items;
}
elsif ($self->{xref})
{
$p .= qq( ID="$self->{xref}");
}
+
$p .= "/" unless defined $value || $tag;
- $p .= ">\n";
+ $p .= ">";
+ $p .= "\n"
+ if $sub_items ||
+ (!$spaced &&
+ (!(defined $value || $tag) || $tag eq "EVEN" || $self->{xref}));
}
- $p .= "$indent $value\n" if defined $value;
+
+ if (defined $value)
+ {
+ $p .= "$indent " if $spaced || $sub_items;
+ $p .= $value;
+ $p .= "\n" if $spaced || $sub_items;
+ }
+
$fh->print($p);
- for my $c (0 .. @{$self->_items} - 1)
+
+ for my $c (0 .. $sub_items - 1)
{
$self->{items}[$c]->write_xml($fh, $level + 1);
}
- $fh->print("$indent</$tag>\n") if $tag;
+
+ if ($tag)
+ {
+ $fh->print($indent) if $spaced || $sub_items;
+ $fh->print("</$tag>\n");
+ }
}
sub print
@@ -591,10 +626,13 @@ sub full_value
{
my $self = shift;
my $value = $self->{value};
+ $value =~ s/[\r\n]+$// if defined $value;
for my $item (@{$self->_items})
{
- $value .= "\n$item->{value}" if $item->{tag} eq "CONT";
- $value .= $item->{value} if $item->{tag} eq "CONC";
+ my $v = defined $item->{value} ? $item->{value} : "";
+ $v =~ s/[\r\n]+$//;
+ $value .= "\n$v" if $item->{tag} eq "CONT";
+ $value .= $v if $item->{tag} eq "CONC";
}
$value
}
@@ -633,7 +671,7 @@ __END__
Gedcom::Item - a base class for Gedcom::Grammar and Gedcom::Record
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
View
8 Gedcom/LifeLines.pm
@@ -1,4 +1,4 @@
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -20,10 +20,10 @@ BEGIN
eval "use Roman ()";
}
-use Gedcom 1.11;
+use Gedcom 1.12;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = "1.11";
+$VERSION = "1.12";
@ISA = qw( Exporter );
@EXPORT = qw
(
@@ -1261,7 +1261,7 @@ __END__
Gedcom::LifeLines - functions for lines2perl
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
View
8 Gedcom/Record.pm
@@ -1,4 +1,4 @@
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -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.11;
+use Gedcom::Item 1.12;
use vars qw($VERSION @ISA $AUTOLOAD);
-$VERSION = "1.11";
+$VERSION = "1.12";
@ISA = qw( Gedcom::Item );
BEGIN
@@ -600,7 +600,7 @@ __END__
Gedcom::Record - a module to manipulate Gedcom records
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
View
1  MANIFEST
@@ -41,6 +41,7 @@ t/lines/namefreq
t/lines/namefreq.l
t/lines/namefreq.plx
t/ged_create.t
+t/grammar_file.t
royal.ged
gedcom.vim
session.vim
View
13 Makefile.PL
@@ -1,6 +1,6 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
@@ -15,8 +15,8 @@ use ExtUtils::MakeMaker;
$| = 1;
-my $Version = "1.11";
-my $Date = "7th April 2002";
+my $Version = "1.12";
+my $Date = "2nd February 2003";
my $Author = 'pjcj@cpan.org';
my @perlbug = ("perlbug", "-a", $Author,
@@ -210,6 +210,13 @@ ppm : ppd pure_all
-e 's/(CODEBASE HREF=")[^"]*/\$\$1Gedcom.tar.gz/;' \\
Gedcom.ppd
+COVERDIR = /home/pjcj/g/perl/dev/Devel-Cover-0.2003
+
+cover :
+\t rm -rf cover_db && \\
+ HARNESS_PERL_SWITCHES=-I\$(COVERDIR)/blib/lib\\ -I\$(COVERDIR)/blib/arch\\ -MDevel::Cover=-ignore,Cover make test && \\
+ \$(PERL) -I\$(COVERDIR)/blib/lib -I\$(COVERDIR)/blib/arch \$(COVERDIR)/cover -report html
+
ok :
\t \@$Perlbug -okay || echo "Please send your report manually to $Author"
View
4 README
@@ -1,10 +1,10 @@
NAME
Gedcom - a module to manipulate Gedcom genealogy files
- Version 1.11 - 7th April 2002
+ Version 1.12 - 2nd February 2003
DESCRIPTION
- Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+ Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
This software is free. It is licensed under the same terms as Perl
itself.
View
2  TODO
@@ -8,3 +8,5 @@
- Turn children from an array into a hash: key is tag, value is array of items.
- Separate REs for parsing grammar files and gedcom files.
Note: I tried this but it didn't seem to provide much of a benefit.
+- Conversion of notes to and from top level records
+- Include names in index file?
View
12 cgi-bin/gedcom.cgi
@@ -1,23 +1,23 @@
-#!/usr/local/bin/perl -w
+#!/usr/bin/perl -w
-# Copyright 2001-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 2001-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
require 5.005;
-use lib "/home/pjcj/ged/latest";
+use lib "/home/pjcj/g/perl/dev/Gedcom";
use CGI qw(:cgi :html);
-use Gedcom::CGI 1.11;
+use Gedcom::CGI 1.12;
my $op = param("op");
@@ -39,7 +39,7 @@ __END__
main.cgi
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
View
25 ged
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
@@ -18,10 +18,10 @@ use diagnostics;
use Data::Dumper;
$Data::Dumper::Indent = 1;
-use Gedcom 1.11;
+use Gedcom 1.12;
use vars qw( $VERSION );
-$VERSION = "1.11";
+$VERSION = "1.12";
eval "use Date::Manip";
Date_Init("DateFormat=UK") if $INC{"Date/Manip.pm"};
@@ -41,13 +41,18 @@ sub main()
callback => sub { print "." },
read_only => 1,
);
- if (0)
+ if (1)
{
- my @i = $ged->get_individual("I82");
+ # my @i = $ged->get_individual("I8");
+ # my @i = grep $_->rin == 8, $ged->individuals;
+ my @i = $ged->individuals;
print "\n", $_->xref, " => ", $_->name, "\n" for @i;
- my $i = shift @i;
+ # my $i = shift @i;
+ my $i = $ged->get_individual("I8");
my $b = $i->birth;
- print "[", scalar $b->age, "]\n";
+ print "[", $i->get_value("fams marriage date"), "]\n";
+ print "[", $i->fams->marriage->date, "]\n";
+ print "[", $i->get_value(qw(famc marriage date)), "]\n";
return;
}
if (0)
@@ -60,12 +65,12 @@ sub main()
# print "\nnormalising dates...";
# $ged->normalise_dates("%E %b %Y");
# sleep 6000;
- if (0)
+ if (1)
{
print "\nwriting xml...";
$ged->write_xml("$gedcom_file.xml");
}
- if (0)
+ if (1)
{
print "\nvalidating...";
my %x;
View
2  gedcom.vim
@@ -1,7 +1,7 @@
" Vim syntax file
" Language: Gedcom
" Maintainer: Paul Johnson (pjcj@cpan.org)
-" Version 1.11 - 7th April 2002
+" Version 1.12 - 2nd February 2003
syntax clear
View
60 lines2perl
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
@@ -23,11 +23,11 @@ use lib $FindBin::Bin;
use Parse::RecDescent;
-use Gedcom 1.11;
-use Gedcom::LifeLines 1.11;
+use Gedcom 1.12;
+use Gedcom::LifeLines 1.12;
use vars qw( $VERSION $Prefix $Suffix );
-$VERSION = "1.11";
+$VERSION = "1.12";
sub _indent
{
@@ -58,8 +58,8 @@ $Prefix = <<'EOH';
#!/usr/local/bin/perl -w
# This program was generated by lines2perl, which is part of Gedcom.pm.
-# Gedcom.pm is Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
-# Version 1.11 - 7th April 2002
+# Gedcom.pm is Copyright 1999-2003, Paul Johnson (pjcj@cpan.org)
+# Version 1.12 - 2nd February 2003
# Gedcom.pm is free. It is licensed under the same terms as Perl itself.
@@ -75,7 +75,7 @@ use integer;
use Getopt::Long;
-use Gedcom::LifeLines 1.11;
+use Gedcom::LifeLines 1.12;
my $Ged; # Gedcom object
my %Opts; # options
@@ -178,6 +178,12 @@ statement : "}" <commit> <reject>
{ "$item[1];\n" }
| set_statement
{ "$item[1];\n" }
+ | getintmsg_statement
+ { "$item[1];\n" }
+ | getstrmsg_statement
+ { "$item[1];\n" }
+ | getindimsg_statement
+ { "$item[1];\n" }
| continue_statement
{ "$item[1];\n" }
| break_statement
@@ -216,6 +222,8 @@ expression : ")" <commit> <reject>
| builtin_function
| emulated_function
| non_call_statement
+ | "(" ")"
+ { "" }
| "(" expression ")"
{ "($item[2])" }
| scalar ...!"("
@@ -431,6 +439,27 @@ global_statement : "global" "(" name ")"
set_statement : "set" "(" scalar "," expression ")"
{ "$item[3] = $item[5]" }
+getintmsg_statement : "getintmsg" "(" scalar "," expression ")"
+ {
+ ::msg($prevline, $prevcolumn,
+ qq(warning: $item[1] needs to be replaced));
+ "$item[3] = $item[5]"
+ }
+
+getstrmsg_statement : "getstrmsg" "(" scalar "," expression ")"
+ {
+ ::msg($prevline, $prevcolumn,
+ qq(warning: $item[1] needs to be replaced));
+ "$item[3] = $item[5]"
+ }
+
+getindimsg_statement : "getindimsg" "(" scalar "," expression ")"
+ {
+ ::msg($prevline, $prevcolumn,
+ qq(warning: $item[1] needs to be replaced));
+ "$item[3] = $item[5]"
+ }
+
continue_statement : "continue" "(" ")"
{ "next LOOP" }
@@ -517,7 +546,9 @@ builtin_function : add_function
| or_function
| not_function
| eq_function
+ | eqstr_function
| ne_function
+ | nestr_function
| lt_function
| le_function
| gt_function
@@ -573,6 +604,12 @@ eq_function : "eq" "(" expression "," expression ")"
ne_function : "ne" "(" expression "," expression ")"
{ "($item[3] != $item[5])" }
+eqstr_function : "eqstr" "(" expression "," expression ")"
+ { "($item[3] eq $item[5])" }
+
+nestr_function : "nestr" "(" expression "," expression ")"
+ { "($item[3] ne $item[5])" }
+
lt_function : "lt" "(" expression "," expression ")"
{ "($item[3] < $item[5])" }
@@ -631,8 +668,8 @@ insert_procedure : "insert" "(" name "," expression "," expression ")"
{ "\$$item[3]" . "->{$item[5]} = $item[7]" }
constant : /([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/
- | /".*(?<!\\")/
- | /'.*(?<!\\')/
+ | /".*?(?<!\\)"/
+ | /'.*?(?<!\\)'/
EOG
@@ -658,6 +695,9 @@ my @keywords =
include
global
set
+ getintmsg
+ getstrmsg
+ getindimsg
continue
break
return
View
10 parse_grammar
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
@@ -15,10 +15,10 @@ require 5.005;
use Data::Dumper;
-use Gedcom 1.11;
+use Gedcom 1.12;
use vars qw( $VERSION );
-$VERSION = "1.11";
+$VERSION = "1.12";
$SIG{__WARN__} = sub { print "\n@_" };
@@ -54,7 +54,7 @@ sub main()
open(G, ">$gpm") or die "Can't open $gpm: $!";
print G <<EOT;
-# Copyright 1998-2002, Paul Johnson (pjcj\@cpan.org)
+# Copyright 1998-2003, Paul Johnson (pjcj\@cpan.org)
# This software is free. It is licensed under the same terms as Perl itself.
View
21 t/Basic.pm
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
@@ -16,15 +16,22 @@ require 5.005;
package Basic;
use vars qw($VERSION);
-$VERSION = "1.11";
+$VERSION = "1.12";
-use Test;
+use Test ();
-use Gedcom 1.11;
+use Gedcom 1.12;
eval "use Date::Manip";
Date_Init("DateFormat=UK") if $INC{"Date/Manip.pm"};
+sub ok
+{
+ my @a = @_;
+ s/[\r\n]+$/\n/ for @a;
+ Test::ok(@a)
+}
+
my @Ged_data = <DATA>;
sub xrefs (@)
@@ -242,7 +249,7 @@ sub import
my $grammar;
if ($grammar = delete $args{create_grammar})
{
- plan tests => $tests + 3;
+ Test::plan tests => $tests + 3;
system ($^X, ((-d "t") ? "." : "..") . "/parse_grammar", $grammar, 0.1);
ok $?, 0;
ok -e "Gedcom/Grammar_0_1.pm";
@@ -250,7 +257,7 @@ sub import
}
else
{
- plan tests => $tests;
+ Test::plan tests => $tests;
}
require Engine;
View
8 t/Engine.pm
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
@@ -16,9 +16,9 @@ require 5.005;
package Engine;
use vars qw($VERSION);
-$VERSION = "1.11";
+$VERSION = "1.12";
-use Gedcom 1.11;
+use Gedcom 1.12;
sub test
{
View
8 t/Lines.pm
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
@@ -19,9 +19,9 @@ use File::Basename;
use Test;
use vars qw($VERSION);
-$VERSION = "1.11";
+$VERSION = "1.12";
-use Gedcom 1.11;
+use Gedcom 1.12;
sub test
{
View
4 t/basic.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
View
4 t/bias.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
View
17 t/birthdates.t
@@ -1,27 +1,34 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
require 5.005;
-use Test;
+use Test ();
-BEGIN { plan tests => 161 }
+BEGIN { Test::plan tests => 161 }
use lib -d "t" ? "t" : "..";
-use Gedcom 1.11;
+use Gedcom 1.12;
use Engine;
+sub ok
+{
+ my @a = @_;
+ s/[\r\n]+$/\n/ for @a;
+ Test::ok(@a)
+}
+
my $Test = sub
{
my $ged = shift;
View
12 t/ged_create.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 2002-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
@@ -19,7 +19,7 @@ use diagnostics;
use Test;
-use Gedcom 1.11;
+use Gedcom 1.12;
$SIG{__WARN__} = sub {};
@@ -108,11 +108,11 @@ __DATA__
2 CORP Paul Johnson
3 ADDR http://www.pjcj.net
2 DATA
-3 COPR Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+3 COPR Copyright 1998-2003, Paul Johnson (pjcj@cpan.org)
1 NOTE
2 CONT This output was generated by Gedcom.pm.
-2 CONT Gedcom.pm is Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
-2 CONT Version 1.11 - 7th April 2002
+2 CONT Gedcom.pm is Copyright 1999-2003, Paul Johnson (pjcj@cpan.org)
+2 CONT Version 1.12 - 2nd February 2003
2 CONT
2 CONT Gedcom.pm is free. It is licensed under the same terms as Perl itself.
2 CONT
View
18 t/grammar_file.t
@@ -0,0 +1,18 @@
+#!/usr/local/bin/perl -w
+
+# Copyright 1998-2003, 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.12 - 2nd February 2003
+
+use strict;
+
+use lib -d "t" ? "t" : "..";
+
+use Basic (resolve => "unresolve_xrefs",
+ read_only => 0,
+ grammar_file => "gedcom-5.5.grammar");
View
4 t/lines.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
# This is really just a test of the lifelines testing mechanism, but it
# also serves as a very basic lifelines test.
View
2  t/lines/bias
@@ -3,7 +3,7 @@ bias
Compute sex bias based on previous births
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
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
10 t/lines/bias.plx
@@ -1,8 +1,8 @@
#!/usr/local/bin/perl -w
# This program was generated by lines2perl, which is part of Gedcom.pm.
-# Gedcom.pm is Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
-# Version 1.11 - 7th April 2002
+# Gedcom.pm is Copyright 1999-2003, Paul Johnson (pjcj@cpan.org)
+# Version 1.12 - 2nd February 2003
# Gedcom.pm is free. It is licensed under the same terms as Perl itself.
@@ -18,7 +18,7 @@ use integer;
use Getopt::Long;
-use Gedcom::LifeLines 1.11;
+use Gedcom::LifeLines 1.12;
my $Ged; # Gedcom object
my %Opts; # options
@@ -68,7 +68,7 @@ $SIG{__WARN__} = sub
#
# Compute sex bias based on previous births
#
-# Version 1.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
#
# 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
@@ -461,7 +461,7 @@ bias
Compute sex bias based on previous births
-Version 1.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
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
6 t/lines/lines.plx
@@ -1,8 +1,8 @@
#!/usr/local/bin/perl -w
# This program was generated by lines2perl, which is part of Gedcom.pm.
-# Gedcom.pm is Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
-# Version 1.11 - 7th April 2002
+# Gedcom.pm is Copyright 1999-2003, Paul Johnson (pjcj@cpan.org)
+# Version 1.12 - 2nd February 2003
# Gedcom.pm is free. It is licensed under the same terms as Perl itself.
@@ -18,7 +18,7 @@ use integer;
use Getopt::Long;
-use Gedcom::LifeLines 1.11;
+use Gedcom::LifeLines 1.12;
my $Ged; # Gedcom object
my %Opts; # options
View
6 t/lines/namefreq.plx
@@ -1,8 +1,8 @@
#!/usr/local/bin/perl -w
# This program was generated by lines2perl, which is part of Gedcom.pm.
-# Gedcom.pm is Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
-# Version 1.11 - 7th April 2002
+# Gedcom.pm is Copyright 1999-2003, Paul Johnson (pjcj@cpan.org)
+# Version 1.12 - 2nd February 2003
# Gedcom.pm is free. It is licensed under the same terms as Perl itself.
@@ -18,7 +18,7 @@ use integer;
use Getopt::Long;
-use Gedcom::LifeLines 1.11;
+use Gedcom::LifeLines 1.12;
my $Ged; # Gedcom object
my %Opts; # options
View
4 t/namefreq.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
# This is really just a test of the lifelines testing mechanism, but it
# also serves as a very basic lifelines test.
View
4 t/parse_grammar.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
View
4 t/read_only.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
View
4 t/resolve.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
View
4 t/resolve_read_only.t
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1999-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1999-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
View
10 tkged
@@ -1,13 +1,13 @@
#!/usr/local/bin/perl -w
-# Copyright 1998-2002, Paul Johnson (pjcj@cpan.org)
+# Copyright 1998-2003, 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.11 - 7th April 2002
+# Version 1.12 - 2nd February 2003
use strict;
@@ -24,10 +24,10 @@ use Tk;
use Carp;
use Data::Dumper;
-use Gedcom 1.11;
+use Gedcom 1.12;
use vars qw( $VERSION );
-$VERSION = "1.11";
+$VERSION = "1.12";
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.11 - 7th April 2002
+Version 1.12 - 2nd February 2003
=head1 SYNOPSIS
Please sign in to comment.
Something went wrong with that request. Please try again.