geo_downloader

   1 #!/usr/bin/perl
   2 # geo_downloader downloads expression files from GEO (NCBI)
   3 # and is released under the terms of the GNU GPL version 3, or any
   4 # later version, at your option. See the file README and COPYING for
   5 # more information.
   6 # Copyright 2013 by Don Armstrong <don@donarmstrong.com>.
   7
   8
   9 use warnings;
  10 use strict;
  11
  12 use Getopt::Long;
  13 use Pod::Usage;
  14
  15 =head1 NAME
  16
  17 geo_downloader - downloads expression files from GEO (NCBI)
  18
  19 =head1 SYNOPSIS
  20
  21 geo_downloader [options] [GSE...]
  22
  23  Options:
  24    --debug, -d debugging level (Default 0)
  25    --help, -h display this help
  26    --man, -m display manual
  27
  28 =head1 OPTIONS
  29
  30 =over
  31
  32 =item B<--debug, -d>
  33
  34 Debug verbosity. (Default 0)
  35
  36 =item B<--help, -h>
  37
  38 Display brief usage information.
  39
  40 =item B<--man, -m>
  41
  42 Display this manual.
  43
  44 =back
  45
  46 =head1 EXAMPLES
  47
  48 geo_downloader GSE20400
  49
  50 =cut
  51
  52
  53 use vars qw($DEBUG);
  54 use Net::FTP;
  55 use Cwd;
  56 use Data::Printer;
  57
  58 my %options = (debug           => 0,
  59                help            => 0,
  60                man             => 0,
  61                host => 'ftp.ncbi.nlm.nih.gov',
  62               );
  63
  64 GetOptions(\%options,
  65            'debug|d+','help|h|?','man|m');
  66
  67 pod2usage() if $options{help};
  68 pod2usage({verbose=>2}) if $options{man};
  69
  70 $DEBUG = $options{debug};
  71
  72 my @USAGE_ERRORS;
  73 if (not @ARGV) {
  74     push @USAGE_ERRORS,"You must give at least one GEO accession";
  75 }
  76
  77 if (@ARGV != grep {/^(gpl|gse|gsm|gds)\d+$/i} @ARGV) {
  78     push @USAGE_ERRORS,"Invalid GEO accession(s): ".
  79         join(',',grep {$_ !~ /^(gpl|gse|gsm)\d+$/} @ARGV);
  80 }
  81
  82
  83 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
  84
  85 my $ftp = Net::FTP->new($options{host},Debug=>$DEBUG,Passive=>1) or
  86     die "Unable to create new Net::FTP object";
  87 print STDERR "Connected\n" if $DEBUG;
  88
  89 $ftp->login('anonymous') or
  90     die "Unable to login";
  91 print STDERR "logged in\n" if $DEBUG;
  92
  93 $ftp->binary();
  94 print STDERR "binary\n" if $DEBUG;
  95
  96 use Data::Printer;
  97
  98 for my $geo_acc (@ARGV) {
  99     my $geo_directory = geo_directory($geo_acc);
 100     my $listing = recursive_file_listing($ftp,$geo_directory);
 101     p($listing) if $DEBUG;
 102     my $orig_dir = getcwd;
 103     mkdir($geo_acc) unless -d $geo_acc;
 104     chdir($geo_acc);
 105     for my $dir (qw(matrix miniml suppl)) {
 106         # we want all of the raw files, the xml file, and the matrix file
 107         if (exists $listing->{$dir} and ref($listing->{$dir})) {
 108             for my $file (keys %{$listing->{$dir}}) {
 109                 next if ref($listing->{$dir}{$file});
 110                 $ftp->get($listing->{$dir}{$file});
 111             }
 112         }
 113     }
 114     chdir($orig_dir);
 115 }
 116
 117
 118 sub recursive_file_listing {
 119     my ($ftp,$dir) = @_;
 120     my $listing;
 121     my $orig_dir = $ftp->pwd();
 122     eval {
 123         $ftp->cwd($dir) or die "Not a directory $dir";
 124         $listing = {};
 125         my @files = $ftp->ls();
 126         p @files if $DEBUG;
 127         for my $file (@files) {
 128             print STDERR "file: $file\n";
 129             my $subdirs = recursive_file_listing($ftp,$file);
 130             if (defined $subdirs) {
 131                 print STDERR  "subdirs is :";
 132                 print STDERR p($subdirs);
 133                 $listing->{$file} = $subdirs;
 134             } else {
 135                 print STDERR "No subdirectory\n";
 136                 $listing->{$file} = $orig_dir.'/'.$dir.'/'.$file;
 137             }
 138         }
 139     };
 140     $ftp->cwd($orig_dir);
 141     return $listing;
 142 }
 143
 144
 145
 146 sub geo_directory {
 147     my $geo_acc = shift;
 148     $geo_acc = uc($geo_acc);
 149     my $geo_acc_dir = $geo_acc;
 150     $geo_acc_dir =~ s/\d{3}$/nnn/;
 151     my $geo_type_dir = undef;
 152     if ($geo_acc =~ /^GSE/) {
 153         $geo_type_dir = 'series';
 154     } elsif ($geo_acc =~ /^GDS/) {
 155         $geo_type_dir = 'datasets';
 156     } elsif ($geo_acc =~ /^GPL/) {
 157         $geo_type_dir = 'platforms';
 158     } elsif ($geo_acc =~ /^GSM/) {
 159         $geo_type_dir = 'samples';
 160     }
 161     return "/geo/".$geo_type_dir.'/'.$geo_acc_dir.'/'.$geo_acc;
 162 }
 163
 164 __END__