The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

PJCJ / Gedcom-1.22 / parse_grammar 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

              
#!/usr/local/bin/perl -w
# Copyright 1998-2019, 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.22 - 15th November 2019
use strict;
require 5.005;
use Data::Dumper;
use Gedcom;
use vars qw( $VERSION );
$VERSION = "1.22";
$SIG{__WARN__} = sub { print "\n@_" };
sub main {
    die "usage: $0 grammar_file [version]\n" unless @ARGV == 1 || @ARGV == 2;
    my ($grammar_file, $version) = @ARGV;
    ($version) = $grammar_file =~ /(\d+(\.\d+)*)/ unless defined $version;
    die "version must be a gedcom version number\n" unless $version;
    $| = 1;
    print "reading $grammar_file ...";
    my $grammar = Gedcom::Grammar->new(
        file     => $grammar_file,
        version  => $version,
        callback => sub { print "." }
    );
    delete $grammar->{callback};
    delete $grammar->{stored_record};
    my $me = "Unknown user";
    my $login = $me;
    if ($login = getlogin || (getpwuid($<))[0] || $ENV{USER} || $ENV{LOGIN}) {
        my $name;
        eval { $name = (getpwnam($login))[6] };
        $me = $name || $login;
    }
    my $date = localtime;
    (my $v = $version) =~ tr/./_/;
    my $g   = "Grammar_$v";
    my $gpm = "lib/Gedcom/$g.pm";
    print "\nwriting $gpm ...\n";
    open(G, ">$gpm") or die "Can't open $gpm: $!";
    print G <<EOT;
# Copyright 1998-2019, 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
# This file was automatically generated from $grammar_file
# by $me
# on $date
# Do not edit this file.
# Edit $grammar_file if changes need to be made.
# 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 $VERSION - $date
use strict;
require 5.005;
package Gedcom::$g;
use vars qw(\$VERSION \$grammar);
\$VERSION = $VERSION;
EOT
    my $d = Data::Dumper->new([$grammar], ["grammar"]);
    $d->Indent(1)->Purity(1)->Quotekeys(0);
    my $dv = eval $Data::Dumper::VERSION;
    $d->Sortkeys(1) if $dv >= 2.12;
    $d->Useperl(1)  if $dv >= 2.12;         # Because of a bug.
    print G $d->Dump;
    close G or die "Can't open $gpm: $!";
}
main