view release on metacpan or  search on metacpan

lib/Gedcom/Item.pm  view on Meta::CPAN

    $self->read if $self->{file} && $self->{file} ne "*";
    $self;
}

sub copy {
    my $self = shift;
    my $item  = $self->new;
    for my $key (qw(level xref tag value pointer min max gedcom)) {
        $item->{$key} = $self->{$key} if exists $self->{$key}
    }
    $item->{items} = [ map { $_->copy } @{$self->_items} ];
    $item
}

sub hash {
    my $self = shift;
    my $item  = {};
    for my $key (qw(level xref tag value pointer min max)) {
        $item->{$key} = $self->{$key} if exists $self->{$key}
    }
    $item->{items} = [ map { $_->hash } @{$self->_items} ];
    $item
}

sub read {
    my $self = shift;

# $self->{fh} = FileHandle->new($self->{file})
    my $fh = $self->{fh} = gensym;
    open $fh, $self->{file} or die "Can't open file $self->{file}: $!\n";

    # try to determine encoding
    my $encoding = "unknown";
    my $bom = 0;
    my $line1 = <$fh>;
    if ($line1 =~ /^\xEF\xBB\xBF/) {
        $encoding = "utf-8";
        $bom = 1;
    } else {
        while (<$fh>) {
            if (my ($char) = /\s*1\s+CHAR\s+(.*?)\s*$/i) {
                $encoding = $char =~ /utf\W*8/i ? "utf-8" : $char;
                last;
            }
        }
    }

    # print "encoding is [$encoding]\n";
    $self->{gedcom}->set_encoding($encoding) if $self->{gedcom};
    if ($encoding eq "utf-8" && $] >= 5.8) {
        binmode $fh,    ":encoding(UTF-8)";
        binmode STDOUT, ":encoding(UTF-8)";
        binmode STDERR, ":encoding(UTF-8)";
    } else {
        binmode $fh;
    }

    # find out how big the file is
    seek($fh, 0, 2);
    my $size = tell $fh;
    seek($fh, $bom ? 3 : 0, 0);  # skip BOM
    $. = 0;

    # initial callback
    my $callback = $self->{callback};;
    my $title = "Reading";
    my $txt1 = "Reading $self->{file}";
    my $count = 0;
    return undef
    if $callback &&
    !$callback->($title, $txt1, "Record $count", tell $fh, $size);

    $self->level($self->{grammar} ? -1 : -2);

    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 (! open I, $if) {
            die "Can't open $if: $!";
        } else {
            my $g = $self->{gedcom}{grammar}->structure("GEDCOM");
            while (<I>) {
                my @vals = split /\|/;
                my $record =
                Gedcom::Record->new(
                    gedcom  => $self->{gedcom},
                    tag     => $vals[0],
                    line    => $vals[3],
                    cpos    => $vals[4],
                    grammar => $g->item($vals[0]),
                    fh      => $fh,
                    level   => 0,
                );
                $record->{xref}  = $vals[1] if length $vals[1];
                $record->{value} = $vals[2] if length $vals[2];
                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";
        }
    }

    unless (@{$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};
                my @g = $self->{grammar}->item($tag);
                # print "<$tag> => <@g>\n";
                if (@g) {
                    $self->parse($item, $g[0]);
                    push @{$self->{items}}, $item;
                    $count++;
                } else {