#-*- perl -*-
#
# Copyright (C) 2005,2006 Ken'ichi Fukamachi
#
# $FML: Outline.pm,v 1.1 2005/09/11 13:12:46 fukachan Exp $
#
package Mail::Message::Outline;
use strict;
use Mail::Message::Language::Japanese::Outline;
=head1 NAME
Mail::Message::Outline - handle outline or outline.
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 METHODS
=cut
# Descriptions: create outine / summary.
# Arguments: OBJ($self) HASH_REF($params)
# Side Effects: none
# Return Value: STR
sub outline
{
my ($self, $params) = @_;
my $header = $self->whole_message_header();
my $msg = $self->find_first_plaintext_message();
my $result = '';
# options
my $is_hdr = $params->{ with_header } || 'yes';
my $is_msg = 1;
# 1. prepend subject.
if ($is_hdr eq 'yes' && defined $header) {
my $subject = $header->get('subject') || '';
use Mail::Message::Subject;
my $subj = new Mail::Message::Subject $subject;
$subj->mime_header_decode();
$result .= $subj->as_external_form();
}
# XXX-TODO [BUG] we cannot handle the encoded phrase. is it correct?
# XXX-TODO 1. decode each paragraph by checking each mime part header
# XXX-TODO 2. run _is_useful_for_summary() for each paragraph
# 2. summarize message to a few lines.
if ($is_msg && defined $msg) {
my $prgbuf = '';
my $found = 0;
my $max = $params->{ summary_max_lines } || 3;
my $total = $msg->paragraph_total();
PARAGRAPH:
for my $i (1 .. $total) {
$prgbuf = $msg->nth_paragraph($i);
LINE:
for my $buf (split(/\n/, $prgbuf)) {
if ($buf && $self->_is_useful_for_summary($buf)) {
$result .= " $buf\n";
$found++;
}
last PARAGRAPH if $found >= $max;
}
}
}
return $result;
}
# Descriptions: check if $buf looks effective string e.g. not quote ?
# Arguments: OBJ($self) STR($buf)
# Side Effects: none
# Return Value: NUM(1 or 0)
sub _is_useful_for_summary
{
my ($self, $buf) = @_;
# ignore empty line.
return 0 if $buf =~ /^\s*$/o;
# ignore string similar to quote.
return 0 if $self->_is_citation_or_signature($buf);
# ignore mail header like patterns.
return 0 if $buf =~ /^X-[-A-Za-z0-9]+:/io;
return 0 if $buf =~ /^Return-[-A-Za-z0-9]+:/io;
return 0 if $buf =~ /^Mime-[-A-Za-z0-9]+:/io;
return 0 if $buf =~ /^Content-[-A-Za-z0-9]+:/io;
return 0 if $buf =~ /^(To|From|Subject|Reply-To|Received):/io;
return 0 if $buf =~ /^(Message-ID|Date):/io;
# o.k.
return 1;
}
# Descriptions: check if $buf looks not effective string e.g. quote ?
# Arguments: OBJ($self) STR($buf)
# Side Effects: none
# Return Value: NUM(1 or 0)
sub _is_citation_or_signature
{
my ($self, $buf) = @_;
use Mail::Message::String;
my $string = new Mail::Message::String $buf;
$string->charcode_convert_to_internal_code();
return 1 if $string->is_citation();
return 1 if $string->is_signature();
my $str = $string->as_str();
if ($str =~ /^[\>\#\|\*\:\;\=]/o) {
return 1;
}
elsif ($str =~ /^in /o) { # citation ?
return 1;
}
elsif ($str =~ /^\w+.*wrote:/io) { # citation.
return 1;
}
elsif ($str =~ /\w+\@\w+/o) { # mail address ?
return 1;
}
elsif ($str =~ /^\S+\>/o) { # citation ?
return 1;
}
elsif ($str =~ /^hi|^hi,/io) { # self introduction.
return 1;
}
return 0;
}
=head2 has_closing_phrase()
check if this message has closing phrase in it.
=head2 set_closing_phrase_rules($rules)
set rules.
=head2 get_closing_phrase_rules()
get rules.
=cut
# Descriptions: check if this message has closing phrase in it.
# Arguments: OBJ($self)
# Side Effects: none
# Return Value: NUM
sub has_closing_phrase
{
my ($self) = @_;
my $msg = $self->find_first_plaintext_message();
my $rules = $self->get_closing_phrase_rules();
my $regexp = join("|", keys %$rules);
if (defined($msg) && $regexp) {
my ($buf, $string);
my $num_prg = $msg->paragraph_total();
for (my $i = 1; $i <= $num_prg; $i++) {
$buf = $msg->nth_paragraph($i);
$buf =~ s/^[\s\n]*//o;
$buf =~ s/[\s\n]*$//o;
if ($buf) {
$string = new Mail::Message::String $buf;
$string->charcode_convert_to_internal_code();
$buf = $string->as_str();
if ($buf =~ /$regexp/) { return 1;}
}
}
}
return 0;
}
# Descriptions: set phrase trap rules.
# Arguments: OBJ($self) HASH_REF($rules)
# Side Effects: update $self.
# Return Value: none
sub set_closing_phrase_rules
{
my ($self, $rules) = @_;
if (defined $rules) {
$self->{ _closing_phrase_rules } = $rules || {};
}
}
# Descriptions: return phrase trap rules.
# Arguments: OBJ($self)
# Side Effects: none
# Return Value: HASH_REF
sub get_closing_phrase_rules
{
my ($self) = @_;
my $rules = $self->{ _closing_phrase_rules } || {};
return $rules;
}
=head1 CODING STYLE
See C on fml coding style guide.
=head1 AUTHOR
Ken'ichi Fukamachi
=head1 COPYRIGHT
Copyright (C) 2005,2006 Ken'ichi Fukamachi
All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.
=head1 HISTORY
Mail::Message::Outline first appeared in fml8 mailing list driver package.
See C for more details.
=cut
1;