view release on metacpan or  search on metacpan

lib/Astro/Catalog/IO/TST.pm  view on Meta::CPAN

        $construct{magerr} = {};
        for my $key (keys %$star) {
            print "LOOPING KEY = $key\n" if $DEBUG;

            # Un-Goldy hack number #5 for the SuperCOSMOS catalog, for some
            # bloody stupid reason they've decided to label their magntitudes
            # B_J, R_1, R_2 and I. God help me, if I ever find the guy responsible
            # for this stupid idea. For now lets munge these here and cross our
            # fingers.
            if ($key eq "b_j") {
                $$star{bj_mag} = $star->{$key};
                delete $star->{$key};
                $key = "bj_mag";
            }
            if ($key eq "r_1") {
                $$star{r1_mag} = $star->{$key};
                delete $star->{$key};
                $key = "r1_mag" ;
            }
            if ($key eq "r_2") {
                $$star{r2_mag} = $star->{$key};
                delete $star->{$key};
                $key = "r2_mag" ;
            }
            if ($key eq "i") {
                $$star{i_mag} = $star->{$key};
                delete $star->{$key};
                $key = "i_mag" ;
            }

            # drop through unless we have a magnitude
            next unless $key =~ /^(.*?)_?mag$/; # non-greedy

            # No capture - assume R
            my $filter = ( $1 ? uc($1) : "R" );

            # if the filter starts with e_ then it is probably an
            # error in the magnitude
            if ($filter =~ /^E_(\w+)$/i) {
                # error in magnitude
                my $err = $1;
                $construct{magerr}->{$err} = $star->{$key}
                    if $star->{$key} =~ /\d/;
                print "Found Mag Error $err ... \n" if $DEBUG;
            }
            elsif ($filter =~ /_/) {
                # is this a color?
                warnings::warnif "Found unrecognised filter string: $filter\n";
            }
            else {
                # Assume it is a filter
                $construct{magnitudes}->{$filter} = $star->{$key};
                print "Found filter $filter ...\n" if $DEBUG;
            }
        }

        my (@fluxes, @colors);
        foreach my $fkey (keys %{$construct{magnitudes}}) {
            my $num;
            if (defined $construct{magerr}->{$fkey}) {
                $num = new Number::Uncertainty(
                    Value => $construct{magnitudes}->{$fkey},
                    Error => $construct{magerr}->{$fkey});
            }
            else {
                $num = new Number::Uncertainty(
                    Value => $construct{magnitudes}->{$fkey});
            }
            my $mag = new Astro::Flux($num, 'mag', "$fkey");
            push @fluxes, $mag;
        }
        delete $construct{magnitudes};
        delete $construct{magerr} if defined $construct{magerr};

        # Colors: Look for B-V
        $construct{colours} = {};
        for my $key (keys %$star) {
            next unless $key =~ /^(\w)-(\w)$/; # non-greedy
            $construct{colours}->{uc($key)} = $star->{$key};
            print "Found colour ".uc($key)." ... \n" if $DEBUG;
        }
        foreach my $ckey (keys %{$construct{colours}}) {
            my @filters = split "-", $ckey;
            my $color = new Astro::FluxColor(
                upper => new Astro::WaveBand(Filter => $filters[0]),
                lower => new Astro::WaveBand(Filter => $filters[1]),
                quantity => new Number::Uncertainty(Value => $construct{colours}->{$ckey}));
            push @colors, $color;
        }
        delete $construct{colours};

        # build the fluxes object from the available data
        if (defined $fluxes[0]  && defined $colors[0]) {
            $construct{fluxes} = new Astro::Fluxes(@fluxes, @colors);
        }
        elsif (defined $colors[0] ) {
            $construct{fluxes} = new Astro::Fluxes(@colors);
        }
        elsif (defined $fluxes[0] ) {
            $construct{fluxes} = new Astro::Fluxes(@fluxes);
        }
        else {
            delete $construct{fluxes} if defined $construct{fluxes};
        }

        print Dumper(\%construct) . "\n" if $DEBUG;

        # Modify the array in place
        $star = new Astro::Catalog::Item( id => $star->{id}, %construct );
    }

    return new Astro::Catalog(Stars => \@stars);
}

=item B<_write_catalog>

Create an output catalog in the TST format and return the lines
in an array.

    $ref = Astro::Catalog::IO::TST->_write_catalog($catalog);

Argument is an C<Astro::Catalog> object.

=cut

sub _write_catalog {
    croak ('Usage: _write_catalog($catalog, [%opts])') unless scalar(@_) >= 1;
    my $class = shift;
    my $catalog = shift;

    my @output;

    # First, the header. We're only going to write the ID, RA, and Dec.
    push @output, "Id\tra\tdec";
    push @output, "--\t--\t---";

    # Now loop through the stars and push their respective IDs, RAs, and
    # Decs onto the output array.
    foreach my $star ($catalog->stars) {
        my $output_string = "";

        $output_string .= $star->id;
        $output_string .= "\t";
        $output_string .= $star->coords->ra->string;
        $output_string .= "\t";
        $output_string .= $star->coords->dec->string;