File Coverage

blib/lib/Geo/GNS/Parser.pm
Criterion Covered Total %
statement 9 32 28.1
branch 0 14 0.0
condition n/a
subroutine 3 4 75.0
pod 1 1 100.0
total 13 51 25.4


line stmt bran cond sub pod time code
1             package Geo::GNS::Parser;
2 1     1   70492 use warnings;
  1         3  
  1         67  
3 1     1   10 use strict;
  1         3  
  1         88  
4             require Exporter;
5             our @ISA = qw(Exporter);
6             our @EXPORT_OK = qw/parse_file @fields/;
7 1     1   9 use Carp;
  1         14  
  1         1014  
8             our $VERSION = '0.02';
9              
10             our $data_dir = '/home/ben/data/gns';
11              
12             # See L for
13             # explanations.
14              
15             our @fields = qw/RC UFI UNI LAT LONG DMS_LAT DMS_LONG MGRS JOG FC DSG
16             PC CC1 ADM1 POP ELEV CC2 NT LC SHORT_FORM GENERIC SORT_NAME_RO
17             FULL_NAME_RO FULL_NAME_ND_RO SORT_NAME_RG FULL_NAME_RG FULL_NAME_ND_RG
18             NOTE MODIFY_DATE/;
19              
20             sub parse_file
21             {
22 0     0 1   my (%options) = @_;
23 0           my $file = $options{file};
24 0           my $data = $options{data};
25 0           my $callback = $options{callback};
26 0           my $callback_data = $options{callback_data};
27 0 0         if (! $file) {
28 0           croak "Specify a file with 'file =>'";
29             }
30 0 0         if ($file !~ m!/!) {
31 0           $file = "$data_dir/$file";
32             }
33 0 0         open my $input, "<:encoding(utf8)", $file or die $!;
34 0           while (<$input>) {
35 0           my @parts = split /\t/;
36 0 0         if (@parts != 29) {
37 0           die "$file:$.: bad line containing " . scalar (@parts) . " parts.\n";
38             }
39 0           my %line;
40 0           @line{@fields} = @parts;
41 0           my $ufi = $line{UFI};
42 0 0         if ($callback) {
43 0           &{$callback} ($callback_data, \%line);
  0            
44             }
45 0 0         if ($data) {
46 0           push @$data, \%line;
47             }
48             }
49 0 0         close $input or die $!;
50             }
51              
52             1;