Geo::ICAO - Airport and ICAO codes lookup

    use Geo::ICAO qw{ :all };

    my @region_codes = all_region_codes();
    my @region_names = all_region_names();
    my $code   = region2code('Canada');
    my $region = code2region('C');

    my @country_codes = all_country_codes();
    my @country_names = all_country_names();
    my @codes  = country2code('Brazil');
    my $region = code2country('SB');

    my @airport_codes = all_airport_codes('B');
    my @airport_names = all_airport_names('B');
    my $code    = airport2code('Lyon Bron Airport');
    my $airport = code2airport('LFLY');
    my ($airport, $location) = code2airport('LFLY'); # list context

  Jerome Quelin

# 
# This file is part of Geo-ICAO
# 
# This software is copyright (c) 2007 by Jerome Quelin.
# 
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# 
use 5.008;
use warnings;
use strict;

package Geo::ICAO;
our $VERSION = '1.100140';
# ABSTRACT: Airport and ICAO codes lookup

use Carp;
use File::ShareDir qw{ dist_dir };
use List::Util     qw{ first };
use Path::Class;
use Readonly;
use Sub::Exporter  qw{ setup_exporter };


# -- exporting
{
    my @regions   = qw{ all_region_codes  all_region_names  region2code  code2region  };
    my @countries = qw{ all_country_codes all_country_names country2code code2country };
    my @airports  = qw{ all_airport_codes all_airport_names airport2code code2airport };
    setup_exporter( {
        exports => [ @regions, @countries, @airports ],
        groups  => {
            region  => \@regions,
            country => \@countries,
            airport => \@airports,
        }
    } );
}


#-- private vars.

# - vars defined statically

# list of ICAO codes for the regions with their name.
Readonly my %code2region => (
    A => 'Western South Pacific',
    B => 'Iceland/Greenland',
    C => 'Canada',
    D => 'West Africa',
    E => 'Northern Europe',
    F => 'Southern Africa',
    G => 'Northwestern Africa',
    H => 'Northeastern Africa',
    K => 'USA',
    L => 'Southern Europe and Israel',
    M => 'Central America',
    N => 'South Pacific',
    O => 'Southwest Asia, Afghanistan and Pakistan',
    P => 'Eastern North Pacific',
    R => 'Western North Pacific',
    S => 'South America',
    T => 'Caribbean',
    U => 'Russia and former Soviet States',
    V => 'South Asia and mainland Southeast Asia',
    W => 'Maritime Southeast Asia',
    Y => 'Australia',
    Z => 'China, Mongolia and North Korea',
);

# list of ICAO codes for the countries with their name.
Readonly my %code2country => _get_code2country();

# location of data file
Readonly my $FDATA => file( dist_dir('Geo-ICAO'), 'icao.data' );


# - vars computed after other vars

my %region2code = reverse %code2region;
my %country2code;
{ # need to loop, since some countries have more than one code.
    foreach my $code ( keys %code2country ) {
        my $country = $code2country{$code};
        push @{ $country2code{$country} }, $code;
    }
}


#-- public subs

# - subs handling regions.


sub all_region_codes { return keys %code2region; }
sub all_region_names { return keys %region2code; }



sub region2code { return $region2code{$_[0]}; }
sub code2region {
    my ($code) = @_;
    my $letter = substr $code, 0, 1; # can be called with an airport code
    return $code2region{$letter};
}


# - subs handling countries.


sub all_country_codes {
    my ($code) = @_;

    return keys %code2country unless defined $code; # no filters
    # sanity checks on params
    croak "'$code' is not a valid region code" unless defined code2region($code);
    return grep { /^$code/ } keys %code2country;    # filtering
}



sub all_country_names {
    my ($code) = @_;

    return keys %country2code unless defined $code; # no filters
    # sanity checks on params
    croak "'$code' is not a valid region code" unless defined code2region($code);

    # %country2code holds array refs. but even if a country has more
    # than one code assigned, they will be in the same region: we just
    # need to test the first code.
    return grep { $country2code{$_}[0] =~ /^$code/ } keys %country2code;
}



sub country2code {
    my ($country) = @_;
    my $codes = $country2code{$country};
    return defined $codes ? @$codes : undef;
}



sub code2country {
    my ($code) = @_;
    return $code2country{$code}
        || $code2country{substr($code,0,2)}
        || $code2country{substr($code,0,1)};
}


# - subs handling airports


sub all_airport_codes {
    my ($code) = @_;

    # sanity checks on params
    croak 'should provid a region or country code' unless defined $code;
    croak "'$code' is not a valid region or country code"
        unless exists $code2country{$code}
            || exists $code2region{$code};

    open my $fh, '<', $FDATA or die "can't open $FDATA: $!";
    my @codes;
    LINE:
    while ( my $line = <$fh>) {
        next LINE unless $line =~ /^$code/;  # filtering on $code
        my ($c, undef) = split/\|/, $line;
        push @codes, $c;
    }
    close $fh;
    return @codes;
}



sub all_airport_names {
    my ($code) = @_;

    # sanity checks on params
    croak 'should provid a region or country code' unless defined $code;
    croak "'$code' is not a valid region or country code"
        unless exists $code2country{$code}
            || exists $code2region{$code};

    open my $fh, '<', $FDATA or die "can't open $FDATA: $!";
    my @codes;
    LINE:
    while ( my $line = <$fh>) {
        next LINE unless $line =~ /^$code/;  # filtering on $code
        my (undef, $airport, undef) = split/\|/, $line;
        push @codes, $airport;
    }
    close $fh;
    return @codes;
}



sub airport2code {
    my ($name) = @_;

    open my $fh, '<', $FDATA or die "can't open $FDATA: $!";
    LINE:
    while ( my $line = <$fh>) {
        my ($code, $airport, undef) = split/\|/, $line;
        next LINE unless lc($airport) eq lc($name);
        close $fh;
        return $code;
    }
    close $fh;
    return;          # no airport found
}



sub code2airport {
    my ($code) = @_;

    open my $fh, '<', $FDATA or die "can't open $FDATA: $!";
    LINE:
    while ( my $line = <$fh>) {
        next LINE unless $line =~ /^$code\|/;
        chomp $line;
        my (undef, $airport, $location) = split/\|/, $line;
        close $fh;
        return wantarray ? ($airport, $location) : $airport;
    }
    close $fh;
    return;          # no airport found
}


# -- private subs

#
# my %data = _get_code2country();
#
# read the country.data file shipped in the share/ directory, parse and
# return it as a hash. the key is the country code, the value is the
# country name.
#
sub _get_code2country {
    my %data;
    my $file = file( dist_dir('Geo-ICAO'), 'country.data' );
    open my $fh, '<', $file or die "can't open $file: $!";
    while ( my $line = <$fh>) {
        chomp $line;
        my ($code, $country) = split/\|/, $line;
        $data{$code} = $country;
    }
    close $fh;
    return %data;
}


1;

__END__