Permalink
Browse files

Version 1.09

  • Loading branch information...
1 parent c93cbe4 commit af7dbd37797fe9cbecf5fcdb7ed5fcff33b99774 @pjcj committed Feb 21, 2005
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
@@ -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,21 +158,19 @@ 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
{
my $proto = shift;
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,18 +764,24 @@ 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
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
@@ -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
@@ -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
Oops, something went wrong.

0 comments on commit af7dbd3

Please sign in to comment.