ru.linux

 
 - RU.LINUX ---------------------------------------------------------------------
 From : Yuriy Kaminskiy                      2:5020/517.21  26 Mar 2002  18:09:59
 To : kaa
 Subject : Re: how to compose html mail from command line
 -------------------------------------------------------------------------------- 
 

 Content-Type: text/plain
 Content-Transfer-Encoding: 8bit
 
  Hello,  news! 
 
 >>>>> On 22:11 25/3/2002, news@kaa.kiev.ua wrote:
  n> ситуация такая: по крону дергаю wget'ом страничку, которая
  n> генеряется из базы при каждом обращениии.  как мне её сразу послать
  n> почтой, так чтобы письмо было не plain text с аттачем (не во всех
  n> почтовых клиентах это красиво выглядит), а чтобы пришел сразу html
  n> composed e-mail ?  а если туда ещё и картинку приаттачить ( чтобы
  n> на него можно было сослаться прямо из тела письма примерно вот так
  n> - img src="cid:logo.gif")
 
  Хм. Hасчет готовых тулз - не знаю, а так - perl, HTML::Parse (см. в
 качестве примера hrefsub), MIME::Lite (см. man MIME::Lite
 /with images included), LWP в зубы - и вперед :)
 -- 
 Yuriy Kaminskiy.
 PS Вот, лови, на первый взгляд работает:
 
 --=-=-=
 Content-Disposition: attachment; filename=html2mime
 
 #!/usr/local/bin/perl
 
 use strict;
 use HTML::Parser ();
 use URI;
 use MIME::Lite ();
 use LWP::UserAgent ();
 use HTTP::Request ();
 use HTTP::Cookies ();
 
 my %link_attr;
 BEGIN {
     # To simplify things we reformat the %HTML::Tagset::linkElements
     # hash so that it is always a hash of hashes.
     require HTML::Tagset;
     while (my($k,$v) = each %HTML::Tagset::linkElements) {
   if (ref($v)) {
       $v = { map {$_ => 1} @$v };
   }
   else {
       $v = { $v => 1};
   }
   $link_attr{$k} = $v;
     }
 }
 delete @link_attr{qw/a/};
 
 our $base_uri = shift || usage();
 my $to = shift || usage();
 my $subj = shift || usage();
 
 my $msg;
 $msg = MIME::Lite->new(
              Type    =>'multipart/related',
        To       => $to,
        Subject => $subj,
              );
 while(@ARGV > 1) {
     $msg->attr(splice(@ARGV,0,2));
 }
 my $main_part = $msg->attach();
 
 my @html_data;
 my $id = 0;
 my %uri2cid;
 
 my $ua = LWP::UserAgent->new;
 
 $ua->cookie_jar(HTTP::Cookies->new);
 
 my $p = HTML::Parser->new(api_version => 3);
 
 $p->handler(default => sub { push @html_data, @_ }, "text");
 $p->handler(start => sub {
 
   my($tagname, $pos, $text) = @_;
   if (my $link_attr = $link_attr{$tagname}) {
       while (4 <= @$pos) {
    # use attribute sets from right to left
    # to avoid invalidating the offsets
    # when replacing the values
    my($k_offset, $k_len, $v_offset, $v_len) =
        splice(@$pos, -4);
    my $attrname = lc(substr($text, $k_offset, $k_len));
    next unless $link_attr->{$attrname};
    next unless $v_offset; # 0 v_offset means no value
    my $v = substr($text, $v_offset, $v_len);
    $v =~ s/^([\'\"])(.*)\1$/$2/;
    my $new_v;
    if(exists $uri2cid{$v}) {
        $new_v = $uri2cid{$v};
    } else {
        $uri2cid{$v}=(); # cache failure
        my $new_uri = URI->new_abs($v, $base_uri);
        next unless defined $new_uri;
        next unless $new_uri->scheme() =~ m{^(?:http|ftp)$};
        # restrict to same site:
        # next if $new_uri->rel($base_uri) == $new_uri;
        # restrict to same base:
        # next if ($new_uri->rel($base_uri)
        #      ->path_segments)[0] eq '..';
        # 
        my $req = HTTP::Request->new(HEAD=>$new_uri);
        my $resp;
        $resp = $ua->request($req);
        next unless $resp->is_success;
        my $content_type = $resp->header('Content-Type');
        # restrict to Content-Type: image/*
        next unless $content_type =~ m{^image/}i;
        $req->method('GET');
        $resp = $ua->request($req);
        next unless $resp->is_success;
        $msg->attach(Type => $content_type,
       Id   => ++$id,
       Data => $resp->content,
        );
        $new_v = "cid:".$id;
        $new_v =~ s/\"/"/g;  # since we quote with ""
        $uri2cid{$v} = $new_v;
    }
    next unless defined $new_v;
    substr($text, $v_offset, $v_len) = qq("$new_v");
       }
   }
   push @html_data, $text;
     },
     "tagname, tokenpos, text");
 
 my $req = HTTP::Request->new(GET => $base_uri);
 my $resp = $ua->request($req, sub {
     my($data, $response, $protocol) = @_;
     local $base_uri = $response->base();
     $p->parse($data);
 });
 die $resp->message unless $resp->is_success;
 
 $p->eof;
 
 $main_part->attr('Content-Type', $resp->header('Content-Type'));
 $main_part->data(\@html_data );
 
 $msg->send;
 
 sub usage
 {
     my $progname = $0;
     $progname =~ s,^.*/,,;
     die "Usage: $progname <url> <addr> <subj> [<header> <value>]...\n";
 }
 
 --=-=-=--
 --- Gnus/5.0808 (Gnus v5.8.8) XEmacs/21.1 (Cuyahoga Valley)
  * Origin: none (2:5020/517.21@fidonet)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор