package Seismic;
use Seismic::Station;
use Seismic::Line;
use Exporter;

our @ISA = qw[ Exporter ];
our @EXPORT = qw[ Easting Northing Other Elevation ];

sub new {
    my( $class, $filename ) = @_;
    my %lines;
    open my $in, '<', $filename or die "$filename : $!";
    while( <$in> ) {
        my( $line, $stn, $x, $y, $other, $z ) =
            unpack 'A8xA8xA9A9xA15xA4', $_;

        $lines{ $line } = Seismic::Line->new( $line )
            unless exists $lines{ $line };

        $lines{ $line }{ $stn } = Seismic::Station->new( $x,$y, $other, $z );
    }
    close $in;
    return bless \%lines, $class;
}

1;

##</code><code>##

package Seismic::Line;

sub new {
    my( $class ) = shift;
    return bless {}, $class;
}

1;

##</code><code>##

package Seismic::Station;
use strict;
use warnings;
use Exporter;

use constant {
    Easting     => 0,
    Northing    => 1,
    Other       => 2,
    Elevation   => 3
};

our @ISA = qw[ Exporter ];
our @EXPORT = qw[ Easting Northing Other Elevation ];

sub dms2real {
    my( $degrees, $minutes, $seconds ) = @_;
    return $degrees + ( $minutes / 60 ) + ( $seconds / 3600 );
}

sub new {
    my( $class, $x, $y, $other, $z ) = @_;
    my $self = bless [], $class;

    die  "Bad Easting ($x)"
        unless $x =~ m[^( ([01]\d{2}) ([0-5]\d) ([0-5]\d{2}) ([NS]) )$]x;
    $self->[ Easting ] = dms2real( $4 eq 'N' ? $2 : - $2, $3, $4 / 10 );

    die  "Bad Northing ($y)"
        unless $y =~ m[^( (\d{2}) ([0-5]\d) ([0-5]\d{3}) ([EW]) )$]x;
    $self->[ Northing ] = dms2real( $4 eq 'E' ? $2 : -$2, $3, $4 / 100 );

    die "Bad other ($other)"
        unless $other   =~ m[^\d{15}$]x;
    $self->[ Other ] = 0 + $other;

    die "Bad Elevation ($z)"
        unless $z =~ m[^( [ 0-9]{3}\d )$]x;
    $self->[ Elevation ] = 0 + $1;

    return $self;
}

1;

##</code><code>##

#! perl -slw
use strict;
use Data::Dump qw[ pp ]; $Data::Dump::MAX_WIDTH = 500;
use Seismic;

my $seismic = Seismic->new( 'seismic.dat' );

for my $lineID ( sort keys %{ $seismic } ) {
    my $line = $seismic->{ $lineID };

    for my $stnID ( sort{$a<=>$b} keys %{ $line } ) {
        my $stn = $line->{ $stnID };

        $stn->[ Easting   ] -= $stn->[ Easting  ] * 0.00001;
        $stn->[ Northing  ] -= $stn->[ Northing ] * 0.000002;
        $stn->[ Elevation ] += 1;

        $stn->[ Other ] = int(
            ( $stn->[ Easting   ]
            * $stn->[ Northing  ]
            * $stn->[ Elevation ]
            ) / 3.0
        );
    }
}

##</code><code>##

package Station;
...
sub adjustAttributes { 
    my( $self ) = shift;

    $self->[ Easting   ] -= $self->[ Easting  ] * 0.00001;
    $self->[ Northing  ] -= $self->[ Northing ] * 0.000002;
    $self->[ Elevation ] += 1;

    $self->[ Other ] = int(
        ( $self->[ Easting   ]
        * $self->[ Northing  ]
        * $self->[ Elevation ]
        ) / 3.0
    );
}

##</code><code>##

    for my $stnID ( sort{$a<=>$b} keys %{ $line } ) {
        my $stn = $line->{ $stnID };

        $stn->adjustAttributes;
    }