#!/usr/bin/perl
#
# ASC -> IDX,URL
# Un programa para transformar puntos de interés (POI)
# de formato asc a formato MKIV.
#
# Joaquín Ferrero. Abril 2006.
#
# Uso:
#   asc2idxurl radars
#   asc2idxurl radars *.asc
#   asc2idxurl radars ones.asc two.asc three.asc
#
# Versiones:
# 20060408 - Primera versión.
# 20060409 - Corregido entrecomillado y finales de linea.
#            Paso del nombre de url a asc.
#            El separador de registros de entrada pasa a msdos.
#            Se genera una cabecera en función del nombre
#            del fichero.
# 20060410 - Basándome en el código de Achirica, crear el fichero
#            url asociado, modificado para el MKIV (MK4).
# 20060412 - Ajustado campos para url (distinta longitud que
#            en idx).
#            Cambio en el cálculo de delta.
# 20060413 - Agregado binmode a la entrada y salida de ficheros.
#            Puesta opción de compilación para perl2exe.
#            Procesar más de un fichero.
# 20060414 - Reescritura (Clean code).
#
# Tab: 4
#

### Perl2exe options ###
#perl2exe_include Text::StripAccents
#perl2exe_include File::Glob

use 5.8.7;
use Text::StripAccents;
use warnings;
use strict;
use constant {
    DEBUG     => 0,
    LONGITUDE => 0,
    LATITUDE  => 1,
    WGS       => 2,
    TEXT      => 3,
    TEXTURL   => 4,
};

#################### CONFIGURATION ####################
my $lang = 'ENG';  # Language SPA, GER, ...

                                    # Url for POI
my $url = "http://tpdhost/cgi/getfile?FILE=%2F"
        . "$lang%2F$lang%5F4%2ECPR&START=36360";

                                    # Integer to lat/lon
sub longitude ($) { ( (shift) + 30 ) * 50_000_000 / 9 }
sub latitude  ($) {   (shift)        * 50_000_000 / 9 }
#sub longitude ($) {   (shift)        * 2**29 / 45 }
#sub latitude  ($) {   (shift)        * 2**29 / 45 }

                                    # End of line
$/ = "\015\012";                    # Input record separator
$\ = "\015\012";                    # Output record separador

                                    # Max text length
my $maxtextlen    = 70;             # idx file
my $maxtexturllen = 35;             # url file
################## END CONFIGURATION ##################

### Help message ###
sub Uso {
  "MKIV Converter from asc files to idx & url files.\n"
. "Use: $0 tag [<file.asc> [...]]\n"
. "Output tag.idx and tag.url\n";
}

### Files to process ###
my @files;
@ARGV or die Uso;                   # No parameters
my $tag = shift;                    # Output's tag name

if ( @ARGV > 1 ) {                  # If more arguments
    push @files, @ARGV;             # Files at line command
}
else {
    push @files, <*.asc>;           # Files at directory
}

### Test of process ###
@files or die "ERROR: No files *.asc to process\n";

### Output files ###
my $idx_file = "$tag.idx";
my $url_file = "$tag.url";
$tag = uc($tag);

### Open files ###
open (IDX,">:bytes", $idx_file)
    or die "ERROR at open $idx_file in writting: $!\n";
open (URL,">:bytes", $url_file)
    or die "ERROR at open $url_file in reading: $!\n";

### Process files ###
print foreach @files;
print "\t-> $idx_file / $url_file";
my  @reg;                              # Data
my  $regnamelen = 0;                   # Max length text data
my  $regwgslen  = 0;                   # Max length position data 
my ($lon, $lat, $text, $texturl, $l, $wgs);

foreach my $file ( @files ) {

    print "Process $file..." if DEBUG;

    open (ASC,"<$file")
        or die "ERROR at open $file in reading: $!\n";
    binmode ASC;

    while ( <ASC> ) {
        next if /^[#;]/;                   # Out comments
        next if /^\s*$/;                   # Out blank lines

        # Read asc file
        #  No headers
        #  Longitude, Latitude, Text
        # We find two values with decimal part
        #     25.66618,  60.39548, "STUDIO 1-2-3"
        #     26,22533   60,45829  KINO MARILYN
        if ( ($lon,      $lat,     $text) = $_ =~
            /^\s*                          # Start with spaces?
            ([\d-]+[.,]\d+)                # First coord (long)
            ,?                             # comma
            \s*                            # spaces?
            ([\d-]+[.,]\d+)                # Second coord (lat)
            ,?                             # comma
            \s*                            # spaces?
            (.+)$                          # text
            /xo
        ) {
            # Filter
            $text =~ s/(\W)(.+)\1/$2/;     # Out text delimeters
            $text =~ s/^\s+|\s+$//g;       # Out blank space
            $text =~ s/  +/ /g;            # Out double space
            $text    = substr($text,0,$maxtextlen);
            $texturl = substr($text,0,$maxtexturllen-1);
            #print "Lon: $lon, Lat: $lat, Txt: $text" if DEBUG;
    
            # integer position -> longitude/latitude
            $lon = sprintf("%d", longitude $lon); 
            $lat = sprintf("%d", latitude  $lat);
            $wgs = "$lon,$lat";
    
            # and store
            push @reg, [ $lon, $lat, $wgs, $text, $texturl ];
    
            # Max length of data
            $l = length $text;
            $regnamelen = $l if $l > $regnamelen;
            $l = length $wgs;
            $regwgslen  = $l if $l > $regwgslen;
      }
      else {
        print "ERROR at line $.. Format unknown";
      }
    }
    close ASC;
}

if ( DEBUG ) {
    print "Number of POI: ", scalar @reg;
    print "Max length of text section: $regnamelen";
    print "Max length of wgs  section: $regwgslen";
}

die "ERROR: No POI data read\n" unless @reg;

### Sort data for longitude value ###
@reg = @reg[
    sort {
        $reg[$a][LONGITUDE] <=> $reg[$b][LONGITUDE]
    } 0 .. $#reg
];

### Size of POI index parts ###
my $regidlen  = int(log(@reg)/log(10) + 1);
my $regurllen = length $url;

### 1. Print headers ###
my @urlheaders = (
    ['POSWGS',      'S', $regwgslen],
    ['NAME',        'S', $maxtexturllen],
    ['STREET',      'S', 24],
    ['HOUSENUMBER', 'S', 4 ],
    ['CITY',        'S', 27],
    ['ZIP',         'S', 6 ],
    ['PHONE',       'S', 15],
    ['FNM',         'S', 0 ],
    ['NT',          'S', 1 ],
    ['FACPAGE',     'S', $regurllen],
    ['_',           'S', 1 ],
);
print URL "${tag}URL-$lang/SE/SF_${tag}.HTM";
print URL join("|", map { join(":", @{$_}) } @urlheaders) ."\0";

my @idxheaders = (
    ['ID',      'I', $regidlen],
    ['POS',     'P', length pack("N2", 0) ],
    ['SELNAME', 'S', $regnamelen],
);
print IDX "Glambda- ${tag}IDX-$lang/SE/SF_${tag}.HTM";
print IDX join("|", map { join(":", @{$_}) } @idxheaders);

### 2. Write POI index part ###
my @longs;
my $regdelta = ( @reg - 2 ) / int( @reg / 50 + .9999 );
print "Delta: $regdelta" if DEBUG;
for ( my $i = 0; $i < @reg; $i += $regdelta ) {
  push @longs, pack("N2", $i, $reg[$i][LONGITUDE] );
}
print IDX join('|', @longs) ."\0";

### 3. Write POI ###
my @val;
for my $i ( 0 .. $#reg ) {
    @val = (
        sprintf("%*s", $regidlen, $i),
        $reg[$i][LONGITUDE], $reg[$i][LATITUDE],
        stripaccents($reg[$i][TEXT]),
    );
    print IDX packet(\@idxheaders, @val);

    @val = (
        $reg[$i][WGS],
        $reg[$i][TEXTURL],
        "",
        "126",
        "",
        "",
        "",
        "1",
        $url,
        "_",
    );
    print URL packet(\@urlheaders, @val);
}

### Close files ###
close URL;
close IDX;

### Subs ###
sub packet {
    my ($href, @values) = @_;
    my @out;

    foreach my $t ( @$href ) {
        my ($type, $size) = @{$t}[1,2];
        next if $size == 0;
        my $valor = shift @values;
        if ( $type eq 'I' ) {
            push @out, sprintf("%*s", $size, $valor);
        }
        elsif ( $type eq 'P' ) {
            push @out, pack("N2", $valor, shift @values);
        }
        elsif ( $type eq 'S' ) {
            push @out, pack("a$size", $valor);
        }
    }
    return join '', @out;
}

__END__