package PS::MOPS::MPC;

# Function mpc_to_miti() has been modified to include extra data processing
# during MPC attribution testing.

use 5.008;
use strict;
use warnings;

use base qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
    mpc_slurp
    mpc_read
    mpc_write
    mpc_format
    mpc_format_miti
    mpc_format_det
    mpc_format_obsdet
    mpc_format_tracklet
    mpc_count_designations
    mpc_split
    mpc_to_miti
    _deg2hms
    _deg2dms
    _hms2deg
    _dms2deg
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our $VERSION = '0.01';

use Astro::Time;

# Globals
our $MPC_FORMAT_SPEC = "%5.5s%-7.7s%1.1s%1.1s%1.1s%-17.17s%-12.12s%-12.12s         %-5.2f%1.1s      %-3.3s";


# Some conversion routines.  Probably put in a module later.

sub _deg2hms {
    # Convert pure degrees to HMS (RA hour/minutes/second) representation.
    my ($deg) = @_;
    my ($h, $m, $s);
    $h = int($deg / 15);    # cvt to hours
    $deg -= $h * 15;
    $m = int($deg * 4);
    $deg -= $m / 4;
    $s = $deg * 240;
    return sprintf "%d %02d %06.3f", $h, $m, $s;
}


sub _deg2dms {
    # Convert pure degrees to DMS (declination degrees/arcminutes/arcseconds) representation.
    my ($deg) = @_;
    my ($d, $arcmin, $arcsec);
    $d = int($deg);
    $deg -= $d;
    $arcmin = int($deg * 60);
    $deg -= $arcmin / 60;
    $arcsec = $deg * 3600;
    return sprintf "%d %02d %06.3f", $d, $arcmin, $arcsec;
}


sub _hms2deg {
    # Convert HMS string to pure degrees.
    my ($str) = @_;
    my ($h, $m, $s) = split /\s+/, $str, 3;
    return $h * 15 + $m / 4 + $s / 240;
}


sub _dms2deg {
    # Convert DMS string to pure degrees.
    my ($str) = @_;
    my ($d, $arcmin, $arcsec) = split /\s+/, $str, 3;
    if ($d < 0) {
        return $d - $arcmin / 60 - $arcsec / 3600;
    }
    else {
        return $d + $arcmin / 60 + $arcsec / 3600;
    }
}


sub mpc_split {
    # Split a line into its separate MPC components.  Return a hashref.
    my ($line) = @_;
    return {
        NUMBER => substr($line, 0, 5),
        DESIGNATION => substr($line, 5, 7),
        DISCOVERY => substr($line, 12, 1),
        CODE => substr($line, 13, 1),
        OBSCODE => substr($line, 14, 1),
        DATE => substr($line, 15, 17),
        RA => substr($line, 32, 12),
        DEC => substr($line, 44, 12),
        MAG => substr($line, 65, 5),
        BAND => substr($line, 70, 1),
        OBSERVATORY => substr($line, 77, 3),
    };
}


sub mpc_slurp {
    # Read observations in specified file into list; return reference to list.
    my ($filename) = shift;
    my $line;
    my @stuff;      # full list in input order
    my $item;       # per-line fields

    open FILE, $filename or die "can't open $filename for reading";
    while (defined($line = <FILE>)) {
        chomp $line;
        next if $line =~ /^\s*$/;   # skip blank lines

        # "Split" line into fields; note some fields abut each other; also
        # MPC format defines first column as column 1, not 0.
        $item = mpc_split($line);
        next unless $item;      # couldn't parse

        # trim leading/trailing spaces.
        foreach (keys %$item) {
            $item->{$_} =~ s/^\s+|\s+$//g;
        }

        # Add to list.
        push @stuff, $item;
    }
    close FILE;
    return \@stuff;
}


sub mpc_write {
    # Write out list of observations to specified filename.
    # If filename is undef or '-', write to STDOUT.
    my ($stuff, $filename) = @_;
    my $str;
    my $line;

    if (not $filename or $filename eq '-') {
        foreach $line (@$stuff) {
            $str = mpc_format($line);    # format into single line
            print $str, "\n";
        }
    }
    else {
        open OUTFILE, ">$filename" or die "can't open $filename for writing";
        foreach $line (@$stuff) {
            $str = mpc_format($line);    # format into single line
            print OUTFILE $str, "\n";
        }
        close OUTFILE;
    }
}


sub mpc_format {
    # Format specified single observation table into single MPC-format line.
    # No tests are done to verify the data conforms to MPC format; namely
    # that the fields fit into allocated columns in the format.  If a
    # data item is larger than the columns allowed by the format, the data
    # item is truncated.
    my $obs = shift;
    my $line = sprintf
        $MPC_FORMAT_SPEC,
        $obs->{NUMBER} ? sprintf("%05s", $obs->{NUMBER}) : "     ",
        $obs->{DESIGNATION},
        $obs->{DISCOVERY},
        $obs->{CODE},
        $obs->{OBSCODE},
        $obs->{DATE},
        $obs->{RA},
        $obs->{DEC},
        $obs->{MAG},
        $obs->{BAND},
        $obs->{OBSERVATORY};
    return $line;
}


sub mpc_format_miti {
    # Format a MITI hash into MPC.
    my %stuff = @_;
    my ($day, $month, $year, $ut) = mjd2cal($stuff{EPOCH_MJD});   # cvt to cal date
    my $date = sprintf "%4d %02d %09.6f", $year, $month, $day + $ut;   # format YYYY MM DD.DDDDDD

    my $saveZero = $Astro::Time::StrZero;   # save package global val
    $Astro::Time::StrZero = 2;  # 2 leading digits for stringified RA/DEC

    my $ra = deg2str($stuff{RA_DEG}, 'H', 3, ' ');
    my $dec = ($stuff{DEC_DEG} > 0 ? '+' : '') . deg2str($stuff{DEC_DEG}, 'D', 2, ' ');

    my $line = sprintf
        $MPC_FORMAT_SPEC,
        "     ",                # number
        $stuff{ID},           # designation
        "",                     # discovery
        "",                     # code
        "C",                    # observation code
        $date,
        $ra,
        $dec,
        $stuff{MAG},
        "V",                    # MITI handles V only
        $stuff{OBSCODE},
        "";

    $Astro::Time::StrZero = $saveZero;  # restore package global
    return $line;
}


sub _datestr2dmyu {
    # Convert the DATE field from an MPC line to an MJD.  The date is
    # in the format 'YYYY MM DD.UUUUUU'.  Return a list containing the
    # values.
    my ($y, $m, $d) = split /\s+/, $_[0];
    return (int($d), $m, $y, $d - int($d));
}


sub _rastr2ra_deg {
    # Convert the RA field (in HH MM SS.SSS) from an MPC line to RA in degrees.
    return str2deg($_[0], 'H');
}


sub _decstr2dec_deg {
    # Convert the RA field (in DD MM SS.SS) from an MPC line to DEC in degrees.
    return str2deg($_[0], 'D');
}



# Given a numbered MPC object, return MITI data.
sub mpc_to_miti {
    # Convert a MPC hash into miti, converting the time, RA and DEC
    # representations.  Return a hashref containing the MITI fields.
    my ($line,$id_prefix) = @_;

    die "No ID prefix" if !$id_prefix;

    my $href = mpc_split($line);

    my %stuff = %{$href};

    my $mag=$stuff{MAG};
    if($mag=~s/\s//g){}


#    if(!defined($mag) || $mag eq ''){
#        print STDERR "Failure: line=$line, mag not defined\n";
#        return undef;
#    }


    my ($d, $m, $y, $ut) = _datestr2dmyu($stuff{DATE});


    my $epoch_mjd=cal2mjd($d, $m, $y, $ut);
    my $ra_deg=_rastr2ra_deg($stuff{RA});
    my $dec_deg=_decstr2dec_deg($stuff{DEC});
    my $obscode=$stuff{OBSERVATORY};

    if(!defined($epoch_mjd)){
#        print STDERR "Failure: line=$line, d=$d, m=$m, y=$y\n";
        return undef;
    }

#    if($ra_deg=~s/\s+//g){}
#    if($dec_deg=~s/\s+//g){}
#    if(!defined($ra_deg) || !defined($dec_deg) || $ra_deg eq '' || $dec_deg eq ''){
#        print STDERR "Failure: line=$line, ra or dec not defined\n";
#        return undef;
#    }

#    if($obscode=~s/\s+//g){}
#    if(!defined($obscode || $obscode eq '')){
#        print STDERR "Failure: line=$line, obscode not defined\n";
#        return undef;
#    }

    my $ID;
    if($id_prefix){
        $ID=$id_prefix . $stuff{NUMBER};
    }

    return {
        ID => $ID,
        EPOCH_MJD => $epoch_mjd,
        RA_DEG => $ra_deg,
        DEC_DEG => $dec_deg,
        MAG => $mag,
        OBSCODE => $obscode
    };
}


sub mpc_format_det {
    # Format PSMOPS Detection pair into MPC format.
    my ($det, $use_detIds) = @_;
    my $line;
    my $date;

    my $saveZero = $Astro::Time::StrZero;
    $Astro::Time::StrZero = 2;  # 2 leading digits for stringified RA/DEC

    my ($day, $month, $year, $ut) = mjd2cal($det->epoch);
    $date = sprintf "%4d %02d %09.6f", $year, $month, $day + $ut;
    $line = sprintf
        $MPC_FORMAT_SPEC,
        "     ",            # formerly NUMBER
        ($use_detIds ? $det->detId : ($det->{objectName} or "XXXXXX")),           # MPC designation/det Id
        " ",                # "discovery" asterisk
        " ",                # NOTE 1 code
        "C",                # NOTE 2 code, usually observation method
        $date,
        deg2str($det->{ra}, 'H', 3, ' '),
        ($det->{dec} > 0 ? '+' : '') . deg2str($det->{dec}, 'D', 2, ' '),
        $det->{mag},
        'V',    # for now
        $det->obscode;

    $Astro::Time::StrZero = $saveZero;  # restore
    return $line;
}

sub mpc_format_obsdet {
    # Format PSMOPS Field and Detection pair into MPC format.
    # If use_detIds is specified, write out the detection ID; otherwise objectName
    my ($field, $det, $use_detIds) = @_;
    my $line;
    my $date;

    my $saveZero = $Astro::Time::StrZero;
    $Astro::Time::StrZero = 2;  # 2 leading digits for stringified RA/DEC

    my ($day, $month, $year, $ut) = mjd2cal($field->epoch);
    $date = sprintf "%4d %02d %09.6f", $year, $month, $day + $ut;
    $line = sprintf
        $MPC_FORMAT_SPEC,
        "     ",            # formerly NUMBER
        ($use_detIds ? $det->detId : ($det->{objectName} or "XXXXXX")),           # MPC designation/det Id
        " ",                # "discovery" asterisk
        " ",                # NOTE 1 code
        "C",                # NOTE 2 code, usually observation method
        $date,
        deg2str($det->{ra}, 'H', 3, ' '),
        ($det->{dec} > 0 ? '+' : '') . deg2str($det->{dec}, 'D', 2, ' '),
        $det->{mag},
        'V',    # for now
        $field->obscode;

    $Astro::Time::StrZero = $saveZero;  # restore
    return $line;
}


sub mpc_format_tracklet {
    # Return an array of MPC-formatted tracklet strings.
    my ($trk, $cheat) = @_;
    my $date;
    my $obscode = '568';

    my $saveZero = $Astro::Time::StrZero;
    $Astro::Time::StrZero = 2;  # 2 leading digits for stringified RA/DEC

    my @lines;
    foreach my $det (@{$trk->detections}) {
        my ($day, $month, $year, $ut) = mjd2cal($det->epoch);
        my $objectName;
        $objectName = $det->objectName if $cheat;

        $date = sprintf "%4d %02d %09.6f", $year, $month, $day + $ut;
        push @lines, (sprintf(
            $MPC_FORMAT_SPEC,
            "     ",            # formerly NUMBER
            $trk->trackletId,           # MPC designation/det Id
            " ",                # "discovery" asterisk
            " ",                # NOTE 1 code
            "C",                # NOTE 2 code, usually observation method
            $date,
            deg2str($det->{ra}, 'H', 3, ' '),
            ($det->{dec} > 0 ? '+' : '') . deg2str($det->{dec}, 'D', 2, ' '),
            $det->{mag},
            'V',    # for now
            $obscode) . 
            ($cheat ? " $objectName" : '')
        );
    }

    $Astro::Time::StrZero = $saveZero;  # restore
    return @lines;
}



sub mpc_count_designations {
    # Routine used mostly for testing and simulation; just counts number
    # of different designations in a list of MPC detections read in by
    # mpc_slurp.
    my ($stuff) = @_;
    my $det;
    my %them;
    my $des;
    foreach $det (@{$stuff}) {
        $des = $det->{DESIGNATION};
        if (defined($des) && $des) { 
            $them{$des} = 1;
        }
    }

    return scalar(keys %them);  # count of keys
}


# Aliasing.
*mpc_read = \&mpc_slurp;


1;
__END__

=head1 NAME

PS::MOPS::MPC - Perl module for reading and writing Minor Planet Center (MPC) files

=head1 SYNOPSIS

  use PS::MOPS::MPC ':all';
  $stuff = mpc_slurp("observations.mpc");
  $stuff = mpc_read("observations.mpc");    # same as mpc_slurp()
  mpc_write($stuff, "output.mpc");

  $str = mcp_format(\%vals);
  print FILE $str, "\n";

  $num = mpc_count_designations($stuff);

=head1 ABSTRACT

  This module reads and writes Minor Planet Center (MPC) files, using
  the 80-column format for minor planets described in

    http://cfa-www.harvard.edu/iau/info/OpticalObs.html

  Observations are read into a hash, keyed by the Provisional/Temporay
  designation specified for an observation.

=head1 DESCRIPTION

  This module reads and writes Minor Planet Center (MPC) files, using
  the 80-column format for minor planets described in

    http://cfa-www.harvard.edu/iau/info/OpticalObs.html

  Observations are read into a hash, keyed by the Provisional/Temporay
  designation specified for an observation.

  When writing files, keys are sorted in alphanumeric order and one
  line is written per observation.  If an error occurs while reading or
  writing the file, die() is called.

  Fields are:

=over 4

=item

NUMBER : Minor Planet Number (5 digits)

=item

DESIGNATION : Temporary or provisional designation (7 digits)

=item

DISCOVERY : "Discovery" asterisk (one digit)

=item

CODE : Standard code descriptor (one digit)

=item

OBSCODE : Describes how observation was made, normally "C" for CCD

=item

DATE : Date of observation.  Typically in the format "2003 08 25.02083".

=item

RA : Observed RA

=item

DEC : Observed declination

=item

MAG : Observed magnitude

=item

BAND : Observed band

=item

OBSERVATORY : Observatory code

=back 4

=head2 EXPORT

None by default.

=head1 SEE ALSO

Official documentation of the MPC format can be found here:

  http://cfa-www.harvard.edu/iau/info/OpticalObs.html

=head1 AUTHOR

Larry Denneau, E<lt>denneau@ifa.hawaii.eduE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2004 by Institute for Astronomy, University of Hawaii

=cut

