view release on metacpan or  search on metacpan

lib/Astro/DSS/JPEG.pm  view on Meta::CPAN

does not have the info (or even has an inappropriate value). Also, large C<angular_size>
values can make the response slow (or even error out).

=item * C<pixel_size>

Define the frame size in pixels, either as a single number (square) or a comma separated
string for a rectangle. Default is 1000 pixels (equivalent to passing C<1000> or
C<'1000,1000'> or even C<'1000x1000'>). Max possible is C<'4096,4096'> total size,
or 1 pixel / arcsecond resolution (e.g. 30*60 = 1800 pixels for 30 arcminutes), which
is the full resolution DSS plates were scanned at.

=back

=head1 NOTES

Some artifacts can be seen at the borders of separate "stripes" of the survey and
also the particular JPEG endpoint used sometimes can leave the corners as plain black
squares (depending on the selected frame size, as it is to do with the way it does
segmentation), so if you want to make sure you have a frame with no corner gaps,
request some more angular size than you want and crop. 

Note that the module test suite won't actually fetch data from either DSS or SIMBAD.
This is mainly to ensure it will not fail even if the DSS & SIMBAD endpoints change,
as you can still use the module by passing the updated urls to the constructor. It
also avoids unneeded strain to those free services.

=cut


sub new {
    my ($class, %opts) = @_;

    my $self = {};
    bless($self, $class);

    $self->{dss_url} = $opts{dss_url}
      || 'http://gsss.stsci.edu/webservices/dssjpg/dss.svc/GetImage';
    $self->{simbad_url} = $opts{simbad_url}
      || 'http://simbad.u-strasbg.fr/simbad/sim-id';
    $self->{ua} = $opts{ua}
      || LWP::UserAgent->new(
        agent => "perl/Astro::DSS::JPEG/$VERSION",
      );

    return $self;
}

sub get_image {
    my ($self, %opts) = @_;
    if ($opts{target} && (! defined $opts{ra} || ! defined $opts{dec})) {
        my $simbad = $self->_get_simbad(%opts);
        %opts = (
            %opts,
            %$simbad
        );
    }

    my $res = $self->_get_dss(_process_options(%opts));
    if ($res->is_success) {
        return $res if $opts{filename};
        return $res->decoded_content;
    } else {
        die "*ERROR* Could not access DSS at: ".$res->request->uri
            ."\nHTTP Response:\n".$res->status_line;
    }
}

sub _get_dss {
    my ($self, %opts) = @_;

    my @request = (
        $self->{dss_url} . sprintf(
            "?POS=%f,%f&SIZE=%f,%f&ISIZE=%.0f,%.0f",
            $opts{ra} * 15,             # Convert to degrees
            $opts{dec},
            $opts{angular_size} / 60,   # Convert to degrees
            $opts{angular_size_y} / 60, # Convert to degrees
            $opts{pixel_size},
            $opts{pixel_size_y}
        )
    );
    push @request, (':content_file' => $opts{filename}) if $opts{filename};
    return $self->{ua}->get(@request);
}

sub _convert_coordinates {
    my %opts = @_;
    ($opts{ra}, $opts{dec}) = @{read_coordinates([@opts{'ra','dec'}])}
        if defined $opts{ra} && defined $opts{dec};
    return %opts;
}

sub _process_options {
    my %opts = _convert_coordinates(@_);

    ($opts{ra}, $opts{dec}) = @{precess([@opts{'ra','dec'}], $opts{epoch},2000)}
        if $opts{epoch} && $opts{epoch} != 2000;

    $opts{angular_size} ||= 30; # 30' Default angular size
    $opts{pixel_size}   ||= 1000;

    if ($opts{angular_size} =~ /(\S+)\s*[,xX]\s*(\S+)/) {
        $opts{angular_size}   = $1 || 30;
        $opts{angular_size_y} = $2;
    }
    if ($opts{pixel_size} =~ /(\S+)\s*[,xX]\s*(\S+)/) {
        $opts{pixel_size}   = $1 || 1000;
        $opts{pixel_size_y} = $2;
    }

    $opts{angular_size_y} = $opts{angular_size} unless $opts{angular_size_y};
    $opts{pixel_size_y}   = $opts{pixel_size}*$opts{angular_size_y}/$opts{angular_size}
        unless $opts{pixel_size_y};

    $opts{"pixel$_"} = min 4096, $opts{"pixel$_"}, $opts{"angular$_"}*60
        for qw/_size _size_y/;

    return %opts;
}

sub _get_simbad {
    my ($self, %opts) = @_;

    my $res = $self->{ua}->get(
        $self->{simbad_url}."?output.format=ASCII&Ident=".$opts{target}
    );
    if ($res->is_success) {
        my $simbad = $res->decoded_content;
        if ($simbad =~ /\(ICRS,ep=J2000,eq=2000\): (\S+ \S+ \S+)\s+(\S+ \S+ \S+)/) {
            $opts{ra}  = $1;
            $opts{dec} = $2;
        } else {
            die "*ERROR* Could not parse SIMBAD output:\n$simbad";
        }
        if ($simbad =~ /Angular size:\s*([0-9.]+)/) { # Get only largest dimension
            $opts{angular_size} = min($1 * 1.5, 600); # Get 50% extra for framing, max out at 10 degrees
        }
    } else {
        die "*ERROR* Could not access SIMBAD at: "
            .$self->{simbad_url}."?output.format=ASCII&Ident=".$opts{target}
            ."\nHTTP response:\n".$res->status_line;
    }

    return \%opts;
}

=head1 AUTHOR

Dimitrios Kechagias, C<< <dkechag at cpan.org> >>


=head1 BUGS

Please report any bugs or feature requests to C<bug-astro-dss-jpeg at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Astro-DSS-JPEG>.
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

You could also submit issues or even pull requests to the
github repo (see below).


=head1 GIT

L<https://github.com/dkechag/Astro-DSS-JPEG>


=head1 ACKNOWLEDGEMENTS

The DSS images are downloaded using a public api of the L<Digitized Sky Survey|https://archive.stsci.edu/dss/>
provided by the L<Space Telescope Science Institute|http://www.stsci.edu>.

Targets by name/id are resolved using the L<SIMBAD Astronomical Database|http://simbad.u-strasbg.fr/simbad/>.


=head1 LICENSE AND COPYRIGHT

This software is copyright (c) 2020 by Dimitrios Kechagias.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

For the images you download with this module, please see the L<STScI site|https://archive.stsci.edu/dss/copyright.html>
for the full copyright info.


=cut

1;