view release on metacpan or  search on metacpan

lib/WebService/MODIS.pm  view on Meta::CPAN

### method for download

sub download {
    my $self = shift;
    my $arg  = shift;
    $self->{targetDir} = $arg if ($arg);
    $arg = shift;
    $self->{forceReload} = $arg if ($arg);

    my $nUrl = @{$self->{url}};

    $self->createUrl if ($nUrl == 0);
    $nUrl = @{$self->{url}};

    if (! -d $self->{targetDir}) {
        make_path($self->targetDir) or croak "Cannot create directory '$self->{targetDir}': $!\n";
    }

    # adjusted from http://stackoverflow.com/questions/6813726/continue-getting-a-partially-downloaded-file
    my $ua = LWP::UserAgent->new(cookie_jar => HTTP::Cookies->new());

    for (my $i=0; $i < $nUrl; $i++) {
        my $file = $self->{targetDir}."/".basename(@{$self->{url}}[$i]);
        unlink($file) if ($self->{forceReload} && -f $file);
        open(my $fh, '>>:raw', $file) or croak "Cannot open '$file': $!\n";
        my $bytes = -s $file;
        my $res;
        if ( $bytes && ! $self->{forceReload}) {
            #print "resume ${$self->{url}}[$i] -> $file ($bytes) " if ($verbose);
            $res = $ua->get(
                ${$self->{url}}[$i],
                'Range' => "bytes=$bytes-",
                ':content_cb' => sub { my ( $chunk ) = @_; print $fh $chunk; }
                );
        } else {
            #print "$URL[$i] -> $destination[$i] " if ($verbose);
            $res = $ua->get(
                ${$self->{url}}[$i],
                ':content_cb' => sub { my ( $chunk ) = @_; print $fh $chunk; }
                );
        }
        close $fh;

        my $status = $res->status_line;
        if ( $status =~ /^(200|206|416)/ ) {
            #print "OK\n" if ($verbose && $status =~ /^20[06]/);
            #print "already complete\n" if ($verbose && $status =~ /^416/);
        } else {
            print "Unknown STATUS: '$status'!\n";
        }
    }
}

###################################################
###################################################
### Internal functions 

### retrieve a list of available MODIS Products
### and return a hash with the name of the first subdirectory 
sub getAvailProducts () {
    my $caller = (caller)[0];
    carp "This is an internal WebService::MODIS function. You should know what you are doing." if ($caller ne "WebService::MODIS");

    my %lookupTable = ();
    my $ua = new LWP::UserAgent;
    foreach my $subdir (@DATA_DIR) {
        my $response = $ua->get("${BASE_URL}/${subdir}");

        unless ($response->is_success) {
            die $response->status_line;
        }

        my $content = $response->decoded_content();
        my @content = split("\n", $content);
        foreach (@content) {
            next if (!/href="M/);
            s/.*href="//;
            s/\/.*//;

            print "Key already exists\n" if exists $lookupTable{$_};
            print "Key already defined\n" if defined $lookupTable{$_};
            print "True\n" if $lookupTable{$_};

            $lookupTable{$_} = $subdir;
        }
    }
    return %lookupTable;
}

### get the available second level directories, named by date
### (YYYY.MM.DD) under which the hdf files reside. This does
### not ensure that the files are really there.
sub getAvailDates() {
    my $caller = (caller)[0];
    carp "This is an internal WebService::MODIS function. You should know what you are doing." if ($caller ne "WebService::MODIS");

    my %lookupTable = ();

    my $ua = new LWP::UserAgent;
    foreach my $key (keys %modisProducts) {
        my @dates=();
        my $response = $ua->get("${BASE_URL}/$modisProducts{$key}/$key");

        unless ($response->is_success) {
            die $response->status_line;
        }

        my $content = $response->decoded_content();
        my @content = split("\n", $content);
        foreach (@content) {
            next if (!/href="20[0-9]{2}\.[0-9]{2}\.[0-9]{2}/);
            s/.*href="//;
            s/\/.*//;
            push(@dates, $_);
        }
        my $datesString = "['".join("', '", @dates)."']";
        $lookupTable{$key} = eval $datesString;
    }
    return %lookupTable;
}

### return a file list for one product and date on the server
sub getDateFullURLs($$) {
    my $caller = (caller)[0];
    carp "This is an internal WebService::MODIS function. You should know what you are doing." if ($caller ne "WebService::MODIS");

    my $product = shift;
    my $date = shift;

    my @flist = ();

    my $ua = new LWP::UserAgent;

    my $response = $ua->get("${BASE_URL}/$modisProducts{$product}/$product/$date");
  
    unless ($response->is_success) {
        die $response->status_line;
    }

    my $content = $response->decoded_content();
    my @content = split("\n", $content);
    foreach (@content) {
        next if (!/href="M/);
        next if (/hdf.xml/);
        s/.*href="//;
        s/".*//;
        push(@flist, "${BASE_URL}/$modisProducts{$product}/$product/$date/$_");
    }
    return(@flist);
}

1;

__END__

=head1 NAME

WebService::MODIS - Perl extension for downloading MODIS satellite data

=head1 SYNOPSIS
  use WebService::MODIS;

  ### to initalize or reload the cached server side directory structure
  initCache;
  ### write the cache to configuration files.
  ### A different directory can be passed as parameter.
  writeCache;
  ### load the cache from a previous writeCache.
  ### A different directory can be passed as parameter.
  readCache;

  ### Only available with use WebService::MODIS qw(:all);
  # my %ret = getModisProducts;
  # print "$_ : $ret{$_}\n" foreach (keys %ret);
  # %ret = getModisGlobal;
  # print "$_ : $ret{$_}\n" foreach (keys %ret);

  ### print available versions of a certain product
  print "Versions of MCD12Q1:";
  print " $_" foreach (getVersions("MCD12Q1"));
  print "\n";

  ### new object of land cover type in Rondonia, Brazil for 2001 and 2010
  my $lct = WebService::MODIS->new(product => "MCD12Q1",