view release on metacpan or  search on metacpan

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

        # Create some coordinates
        # decimal degrees or sexagesimal hours/deg
        if (exists $star->{ra} && exists $star->{dec}) {
            my $units;
            if ($star->{ra} =~ /:/) {
                $units = "sex";
            }
            else {
                # must be decimal degrees
                $units = "deg";
            }

            my $c = new Astro::Coords(
                ra => $star->{ra},
                dec => $star->{dec},
                type => $type,
                units => $units,
                name => $star->{id}
            );

            if (defined $c) {
                $construct{coords} = $c;
            }
            else {
                warnings::warnif("Error instantiating coordinate object");
            }

        }

        # Assume that some field names are standardised. This is
        # probably rubbish (whoever heard of standards!).
        # Need to create a data dictionary with all the alternatives
        # that are in use.
        # Be very scared if we have to provide mapping routines
        for my $starkey (keys %datadict) {
            for my $colname (@{ $datadict{$starkey} }) {
                if (exists $star->{$colname}) {
                    $construct{$starkey} = $star->{$colname};

                    # stop looking
                    next;
                }
            }
        }

        # In GSC, posangle has junk on the end. We know it should be
        # a number
        $construct{posangle} =~ s/\D+$// if exists $construct{posangle};

        # gsc flag requires some work
        if (exists $star->{gsc}) {
            $construct{gsc} = ( $star->{gsc} eq '+' ? "TRUE" : "FALSE");
        }
        elsif ($params{gsc}) {
            $construct{gsc} = "TRUE";
        }

        # Magnitudes <- anything that ends in mag
        # Assdume filter is in X_mag
        # If no prefix assume R (yeah right) - we do not know the
        # source of the catalog at this point so can not even guess
        $construct{magnitudes} = {};
        $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;