perl/etc/crep/fetch_ricexpro_dat.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use warnings;
   4 #use IO::Handle;
   5 #use Time::HiRes qw ( gettimeofday tv_interval );
   6 #use Term::ANSIColor qw(:constants);
   7 use LWP::UserAgent;
   8 #use HTTP::Request::Common qw(POST);
   9 use HTML::TreeBuilder::XPath;
  10 #use LWP::Simple qw ( get );
  11 #use HTTP::Cookies;
  12 #use Text::CSV_XS;
  13 use HTML::TableExtract;
  14 use Data::Dump;
  15
  16 my @ArrayList = qw {RXP_1006 RXP_1009 RXP_1010 RXP_1008 RXP_1007 RXP_1012};
  17 my $Order = '0 hr (Cy3)|0 hr (Cy5)|1 hr (Cy3)|1 hr (Cy5)|3 hr (Cy3)|3 hr (Cy5)|6 hr (Cy3)|6 hr (Cy5)|12 hr (Cy3)|12 hr (Cy5)';
  18
  19 open I,'<','resLOC.anno' or die $!;
  20 open O,'>','resLOC.cydat' or die $!;
  21 print O join("\t",'# FeatureNum',@ArrayList),"\n## $Order\n";
  22
  23 my %Acc2Loc;
  24 while (<I>) {
  25         my ($tigLOC,undef,$FeatureNums) = split /\t/;
  26         #next unless defined $FeatureNums;
  27         my @FeatureNums = split /\|/,$FeatureNums;
  28         next unless @FeatureNums > 0;
  29         #print "$tigLOC,@FeatureNums\n";
  30         ++$Acc2Loc{$_}{$tigLOC} for @FeatureNums;
  31 }
  32
  33 my @AccNums = sort {$a <=> $b} keys %Acc2Loc;
  34 #ddx \%Acc2Loc;
  35 #print "@AccNums\n";
  36 print join(',',@ArrayList),"\n";
  37
  38 my $ua = LWP::UserAgent->new;
  39 $ua->agent("Mozilla/5.0");
  40
  41 for my $FeatureNum (@AccNums) {
  42
  43 #my $FeatureNum = 4865;
  44 #my $Exp = 'RXP_1006';
  45 my %ArrayDat;
  46 for my $Exp (@ArrayList) {
  47
  48 BEGINHTTP:
  49 my $req = HTTP::Request->new(GET => "http://ricexpro.dna.affrc.go.jp/$Exp/view-plot-data.php?featurenum=$FeatureNum");
  50 my $res = $ua->request($req);
  51 # check the outcome
  52 if (! $res->is_success) {
  53         warn "Error: Login as Guest failed !\n";
  54         goto BEGINHTTP;
  55 }
  56
  57 #ddx $res;
  58         my $tmp_html = $res->content;
  59         #print $tmp_html;
  60         $tmp_html = (grep /\<table\>\<tr\>\<th\>\<\/th\>\<th\>0 hr \(Cy3\)\<\/th\>/,(split /\n/,$tmp_html))[0];
  61 #print $tmp_html,"\n";
  62 =pod
  63                 <table><tr><th></th><th>0 hr (Cy3)</th><th>0 hr (Cy5)</th><th>1 hr (Cy3)</th><th>1 hr (Cy5)</th><th>3 hr (Cy3)</th><th>3 hr (Cy5)</th><th>6 hr (Cy3)</th><th>6 hr (Cy5)</th><th>12 hr (Cy3)</th><th>12 hr (Cy5)</th></tr><tr><tr><th>rep1</th><td>1489.2</td><td>1468.1</td><td>2461.9</td><td>2467.7</td><td>2531.5</td><td>2546.4</td><td>3237.8</td><td>4325</td><td>2353</td><td>2589.5</td><tr><th>rep2</th><td>1584.1</td><td>1701.6</td><td>1875.8</td><td>2041.3</td><td>2742.3</td><td>2961.4</td><td>3275</td><td>3770</td><td>3569</td><td>4014</td><tr><th>mean</th><td>1536.6</td><td>1584.9</td><td>2168.9</td><td>2254.5</td><td>2636.9</td><td>2753.9</td><td>3256.4</td><td>4047.5</td><td>2961</td><td>3301.7</td><tr><th>median</th><td>1536.6</td><td>1584.9</td><td>2168.9</td><td>2254.5</td><td>2636.9</td><td>2753.9</td><td>3256.4</td><td>4047.5</td><td>2961</td><td>3301.7</td></tr></table>
  64 =cut
  65         my $te = HTML::TableExtract->new();     #headers => [( undef, '0 hr (Cy3)', '0 hr (Cy5)', '1 hr (Cy3)', '1 hr (Cy5)', '3 hr (Cy3)', '3 hr (Cy5)', '6 hr (Cy3)', '6 hr (Cy5)', '12 hr (Cy3)', '12 hr (Cy5)' )] );
  66         $te->parse("$tmp_html");
  67         my $ts = $te->first_table_found();
  68         my @dat;
  69         unless ($ts) {
  70                 warn "\n[!Table]$tmp_html\n";
  71         }
  72 #ddx $ts;
  73 #   "|0 hr (Cy3)|0 hr (Cy5)|1 hr (Cy3)|1 hr (Cy5)|3 hr (Cy3)|3 hr (Cy5)|6 hr (Cy3)|6 hr (Cy5)|12 hr (Cy3)|12 hr (Cy5)",
  74 #   "rep1|1489.2|1468.1|2461.9|2467.7|2531.5|2546.4|3237.8|4325|2353|2589.5",
  75 #   "rep2|1584.1|1701.6|1875.8|2041.3|2742.3|2961.4|3275|3770|3569|4014",
  76 #   "mean|1536.6|1584.9|2168.9|2254.5|2636.9|2753.9|3256.4|4047.5|2961|3301.7",
  77 #   "median|1536.6|1584.9|2168.9|2254.5|2636.9|2753.9|3256.4|4047.5|2961|3301.7",
  78         foreach my $row ($ts->rows) {
  79                 my @rowdat = @{$row};
  80                 my $title = shift @rowdat;
  81                 unless (defined $title) {
  82                         my $tmp = join("|",@rowdat);
  83                         die if $tmp ne $Order;
  84                         next;
  85                 }
  86                 push @dat,join("|",$title,@rowdat) if $title =~ /^(rep\d+|mean)$/;
  87         }
  88         $ArrayDat{$Exp}=\@dat;
  89         $req = undef;
  90 #ddx \@dat;
  91 }       # $Exp
  92 print $FeatureNum," ---\n";
  93 ddx \%ArrayDat;
  94         my $tmp;
  95         for my $Exp (@ArrayList) {
  96                 $tmp .= "\t" . join(',',@{$ArrayDat{$Exp}} );
  97         }
  98         $tmp = $FeatureNum . $tmp;
  99         print O "$tmp\n";
 100 }       # $FeatureNum
 101 close I;
 102 close O;
 103
 104 __END__