Changeset 840

Show
Ignore:
Timestamp:
05/29/06 18:57:17
Author:
miyagawa
Message:
  • $ua->mirror($req, $file) now doesn't initialize $req so that you can modify headers. Fixes #229
  • Added fake_referer: config to FetchEnclosures? so that it adds Referer: when downloading enclosures
  • Publish::Gmail attaches inline encllosures (e.g. <img>s) as inline, rewriting src to cid:
Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • trunk/plagger/lib/Plagger/Plugin/Filter/FetchEnclosure.pm

    r727 r840  
    3838        my $path = File::Spec->catfile($feed_dir, $enclosure->filename); 
    3939        $context->log(info => "fetch " . $enclosure->url . " to " . $path); 
    40         my $res = $ua->mirror($enclosure->url, $path); 
     40 
     41        my $request = HTTP::Request->new(GET => $enclosure->url); 
     42        if ($self->conf->{fake_referer}) { 
     43            $context->log(debug => "Sending Referer: " . $args->{entry}->permalink); 
     44            $request->header('Referer' => $args->{entry}->permalink); 
     45        } 
     46 
     47        my $res = $ua->mirror($request, $path); 
    4148        $enclosure->local_path($path); # set to be used in later plugins 
    4249 
  • trunk/plagger/lib/Plagger/Plugin/Publish/Gmail.pm

    r796 r840  
    99use Encode; 
    1010use Encode::MIME::Header; 
     11use HTML::Entities; 
     12use HTML::Parser; 
    1113use MIME::Lite; 
    1214 
     
    5355    my $feed = $args->{feed}; 
    5456    my $subject = $feed->title || '(no-title)'; 
     57 
     58    my $enclosure_cb; 
     59    for my $entry ($args->{feed}->entries) { 
     60        $enclosure_cb = $self->prepare_enclosures($entry); 
     61    } 
     62 
    5563    my $body = $self->templatize($context, $feed); 
    5664 
     
    7886    ); 
    7987 
    80     for my $entry ($args->{feed}->entries) { 
    81         for my $enclosure (grep $_->local_path, $entry->enclosures) { 
    82             $msg->attach( 
    83                 Type => $enclosure->type, 
    84                 Path => $enclosure->local_path, 
    85                 Filename => $enclosure->filename, 
    86                 Disposition => 'attachment', 
    87             ); 
    88         } 
     88    if ($enclosure_cb) { 
     89        $enclosure_cb->($msg); 
    8990    } 
    9091 
     
    110111} 
    111112 
     113sub prepare_enclosures { 
     114    my($self, $entry) = @_; 
     115 
     116    if (grep $_->is_inline, $entry->enclosures) { 
     117        # replace inline enclosures to cid: entities 
     118        my %url2enclosure = map { $_->url => $_ } $entry->enclosures; 
     119 
     120        my $output; 
     121        my $p = HTML::Parser->new(api_version => 3); 
     122        $p->handler( default => sub { $output .= $_[0] }, "text" ); 
     123        $p->handler( start => sub { 
     124                         my($tag, $attr, $attrseq, $text) = @_; 
     125                         # TODO: use HTML::Tagset? 
     126                         if (my $url = $attr->{src}) { 
     127                             if (my $enclosure = $url2enclosure{$url}) { 
     128                                 $attr->{src} = "cid:" . $self->enclosure_id($enclosure); 
     129                             } 
     130                             $output .= $self->generate_tag($tag, $attr, $attrseq); 
     131                         } else { 
     132                             $output .= $text; 
     133                         } 
     134                     }, "tag, attr, attrseq, text"); 
     135        $p->parse($entry->body); 
     136        $p->eof; 
     137 
     138        $entry->body($output); 
     139    } 
     140 
     141    return sub { 
     142        my $msg = shift; 
     143 
     144        for my $enclosure (grep $_->local_path, $entry->enclosures) { 
     145            my %param = ( 
     146                Type => $enclosure->type, 
     147                Path => $enclosure->local_path, 
     148                Filename => $enclosure->filename, 
     149            ); 
     150 
     151            if ($enclosure->is_inline) { 
     152                $param{Id} = '<' . $self->enclosure_id($enclosure) . '>'; 
     153                $param{Disposition} = 'inline'; 
     154            } else { 
     155                $param{Disposition} = 'attachment'; 
     156            } 
     157 
     158            $msg->attach(%param); 
     159        } 
     160    } 
     161} 
     162 
     163sub generate_tag { 
     164    my($self, $tag, $attr, $attrseq) = @_; 
     165 
     166    return "<$tag " . 
     167        join(' ', map { $_ eq '/' ? '/' : sprintf qq(%s="%s"), $_, encode_entities($attr->{$_}, q(<>"')) } @$attrseq) . 
     168        '>'; 
     169} 
     170 
     171sub enclosure_id { 
     172    my($self, $enclosure) = @_; 
     173    return Digest::MD5::md5_hex($enclosure->url->as_string) . '@Plagger'; 
     174} 
     175 
    112176sub templatize { 
    113177    my($self, $context, $feed) = @_; 
  • trunk/plagger/lib/Plagger/UserAgent.pm

    r818 r840  
    3232} 
    3333 
     34sub mirror { 
     35    my($self, $request, $file) = @_; 
     36 
     37    unless (ref($request)) { 
     38        return $self->SUPER::mirror($request, $file); 
     39    } 
     40 
     41    # below is copied from LWP::UserAgent 
     42    if (-e $file) { 
     43        my($mtime) = (stat($file))[9]; 
     44        if($mtime) { 
     45            $request->header('If-Modified-Since' => 
     46                             HTTP::Date::time2str($mtime)); 
     47        } 
     48    } 
     49    my $tmpfile = "$file-$$"; 
     50 
     51    my $response = $self->request($request, $tmpfile); 
     52    if ($response->is_success) { 
     53 
     54        my $file_length = (stat($tmpfile))[7]; 
     55        my($content_length) = $response->header('Content-length'); 
     56 
     57        if (defined $content_length and $file_length < $content_length) { 
     58            unlink($tmpfile); 
     59            die "Transfer truncated: " . 
     60                "only $file_length out of $content_length bytes received\n"; 
     61        } 
     62        elsif (defined $content_length and $file_length > $content_length) { 
     63            unlink($tmpfile); 
     64            die "Content-length mismatch: " . 
     65                "expected $content_length bytes, got $file_length\n"; 
     66        } 
     67        else { 
     68            # OK 
     69            if (-e $file) { 
     70                # Some dosish systems fail to rename if the target exists 
     71                chmod 0777, $file; 
     72                unlink $file; 
     73            } 
     74            rename($tmpfile, $file) or 
     75                die "Cannot rename '$tmpfile' to '$file': $!\n"; 
     76 
     77            if (my $lm = $response->last_modified) { 
     78                # make sure the file has the same last modification time 
     79                utime $lm, $lm, $file; 
     80            } 
     81        } 
     82    } 
     83    else { 
     84        unlink($tmpfile); 
     85    } 
     86    return $response; 
     87} 
     88 
    34891; 
    3590