view release on metacpan or  search on metacpan

lib/Ham/ADIF/ADI.pm  view on Meta::CPAN

# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
# vim:ts=8:sw=2:et:sta:sts=2
#########
# Author: rmp
#
package Ham::ADIF::ADI;
use strict;
use warnings;
use XML::LibXML;
use Carp;
use base qw(Ham::ADIF);
use IO::File;
use English qw(-no_match_vars);

our $VERSION = q[2018.03.31];

sub parse_file {
  my ($self, $filename) = @_;

  my $io = IO::File->new($filename, q[r]);

  #########
  # thank goodness ADI is case-insensitive and we're spared using sensible things like record separators
  #
  my $header      = q[];
  my $read_header = 1;
  my $rec         = q[];
  my $recs        = [];

  while(my $line = <$io>) {
    if($line =~ m{<EOR>}smx) {
      #########
      # JA1NLX - ADI with no header
      #
      $read_header = 0;
    }

    if($read_header) {
      $header .= $line;
    } else {
      $rec .= $line;
    }

    if($line =~ m{<EOH>}smix) {
      $self->_process_header($header);
      $read_header = 0;

    } elsif($line =~ m{<EOR>}smix) {
      push @{$recs}, $self->_process_record($rec);
      $rec = q[];
    }
  }

  return $recs;
}

sub _process_record {
  my ($self, $rec) = @_;

  my $struct = {};
  for my $tag (split m{[\r\n<]+}smx, $rec) {
    if(!$tag) {
      next;
    }

    my ($tagname, $length, $type, $value) = $tag =~ m{(.*?):(\d+)(:D)?>(.*?)\s*$}smix;
    if(!$tagname) {
      next;
    }

    $struct->{lc $tagname} = $value;
  }

  return $struct;
}

sub _process_header {
  my ($self, $header) = @_;

  my $struct = {};
  for my $tag (split m{[\r\n]+}smx, $header) {
    if(!$tag) {
      next;
    }

    my ($tagname, $length, $datatype, $value, $enum) = $tag =~ m{<(.*?):(\d+)(?::(.*?))?>(.*?)(?:,[{](.*?)[}])?$}smix;
    if(!$tagname) {
      next;
    }

    $struct->{lc $tagname} = $value;
  }

  return $struct;
}

1;

__END__

=head1 NAME

Ham::ADIF::ADI

=head1 VERSION

$LastChangedRevision: 344 $

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 SUBROUTINES/METHODS

=head2 parse_file

=head1 DIAGNOSTICS

=head1 CONFIGURATION AND ENVIRONMENT

=head1 DEPENDENCIES

=over

=item strict

=item warnings

=item XML::LibXML

=item Carp

=item base

=item Ham::ADIF

=item IO::File

=item English

=back