add postfix grep

[bin.git] / get_pdf

diff --git a/get_pdf b/get_pdf
index 3768e5217970af5e4410e527b23b21c9763b0e01..2aa84169aaa0afe672fd28b00ea69a6fae6597f3 100755 (executable)
--- a/get_pdf
+++ b/get_pdf
@@ -65,12 +65,14 @@ use WWW::Mechanize;
 my %options = (debug           => 0,
               help            => 0,
               man             => 0,
+               use_links       => 1,
               );
 
 my %REFERENCE_TYPES = (pmid => 'pmid|p');
 
 GetOptions(\%options,
           values %REFERENCE_TYPES,
+           'use_links|use-links!',
           'cgi_proxy|cgi-proxy|C=s',
           'http_proxy|http-proxy|H=s',
           'debug|d+','help|h|?','man|m');
@@ -108,7 +110,7 @@ if (exists $options{http_proxy}) {
 }
 
 if ($options{pmid}) {
-    my $m = WWW::Mechanize->new();
+    my $m = WWW::Mechanize->new(agent => 'Mozilla',cookie_jar => {});
     for my $pmid (@ARGV) {
        $pmid =~ s/\D//g;
        next unless length $pmid;
@@ -120,11 +122,13 @@ if ($options{pmid}) {
        eval {
            $m->get($url) or die "Unable to get $url";
            my $orig_mech = $m->clone();
+           use Data::Dumper;
            my @possible_links = $m->find_all_links(text_regex => qr/to\s*read/i);
            # try to find the other links
            push @possible_links,
                grep {my $attr = $_->attrs(); exists $attr->{title} and $attr->{title} =~ qr/Full\s*Text/i}
                    $m->links();
+           print STDERR map {"article link: ".$_->url_abs()."\n"} @possible_links if $DEBUG;
            die "No links" unless @possible_links;
            do {
                $m = $orig_mech;
@@ -150,12 +154,15 @@ if ($options{pmid}) {
        };
        if ($@) {
            print STDERR "$@\n" if $DEBUG;
-           system('links',
-                  exists $options{http_proxy}?('-http-proxy',$options{http_proxy}):(),
-                  $url
-                 ) == 0 or next;
-           rename('temp.pdf',"${pmid}.pdf") if -e 'temp.pdf';
-       }
+            if ($options{use_links}) {
+                system('links2',
+                       # links2 doesn't like the leading http:// of proxies for some reason
+                       exists $options{http_proxy}?('-http-proxy',(map {s{http://}{}; $_} $options{http_proxy})):(),
+                       $url
+                      ) == 0 or next;
+                rename('temp.pdf',"${pmid}.pdf") if -e 'temp.pdf';
+            }
+        }
     }
 }
 
@@ -178,6 +185,11 @@ sub find_pdf_link {
        print STDERR $m->content() if $DEBUG;
     }
     my @possible_links;
+    # this is to prioritize the real link at science direct
+    push @possible_links, grep {my $temp = $_->attrs();
+                               exists $temp->{title} and $temp->{title} =~ qr/Download\s*PDF/i}
+       $m->find_all_links(text_regex => qr/PDF/i);
+    push @possible_links, grep { $_->url_abs() !~ /_orig(?:in)?=article/} $m->find_all_links(text_regex => qr/PDF/i);
     push @possible_links, $m->find_all_links(tag_regex => qr/meta/,
                                             url_regex  => qr/(reprint|\.pdf)/i,
                                            );
@@ -185,16 +197,20 @@ sub find_pdf_link {
     push @possible_links,$m->find_all_links(text_regex => qr/manual\s*download/i);
     print STDERR $m->uri() if $DEBUG;
     print STDERR $m->content() if $DEBUG;
-    print STDERR map{$_->url_abs(),qq(\n)} @possible_links if $DEBUG;
+    print STDERR map{"possible pdf link: ".$_->url_abs().qq(\n)} @possible_links if $DEBUG;
     if (not @possible_links and $DEBUG) {
        print STDERR $m->content();
     }
     my $best_guess = $possible_links[0] if @possible_links;
     for my $link (@possible_links) {
+       print STDERR "trying ".$link->url_abs()."..." if $DEBUG;
        my $r = $m->get($link->url_abs());
        if ($r->header('Content-Type') =~ /pdf/) {
+           print STDERR "success\n" if $DEBUG;
            return $m;
        }
+       print STDERR "failure; content type ".$r->header('Content-Type')."\n" if $DEBUG;
+       print STDERR $m->content() if $DEBUG;
     }
     my @sub_frames = $m->find_all_links(tag_regex=>qr/^i?frame$/);
     for my $frame (@sub_frames) {