blob: 836306c3a79b132e2d5889c08736d1e99ec41c4e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
#!/usr/local/bin/perl
#
# $FML: message_id.pl,v 1.1 2001/04/15 05:05:06 fukachan Exp $
#
use strict;
use File::Basename;
use vars qw(%opts);
use lib qw(lib ../../cpan/lib);
test();
gen_message_id();
for my $msg (@ARGV) {
message_io_test($msg);
}
exit 0;
sub test
{
print "\n* IO test of FML::Header::MessageID module\n";
use FML::Header::MessageID;
my $obj = new FML::Header::MessageID;
my $dir;
chop($dir = `mktemp -d -t /tmp`);
$dir = $dir || "/tmp/a";
-d $dir || system "mkdir /tmp/a";
$obj->open_cache( { directory => $dir } );
my $key = time . "-$$";
for (1 .. 10) {
$obj->set( "$key.$_" , time );
}
print $obj->get( "$key.3" ), "\n";
}
sub message_io_test
{
my ($msg) = @_;
print "\n* extract message_id from $msg\n";
use FileHandle;
my $fd = new FileHandle $msg;
use Mail::Message;
my $msg = Mail::Message->parse( {
fd => $fd,
header_class => 'FML::Header',
});
my $header = $msg->rfc822_message_header;
my $h = $header->extract_message_id_references();
for (@$h) { print $_, "\n";}
}
sub gen_message_id
{
print "\n* generate message_id\n";
use FML::Header::MessageID;
my $obj = new FML::Header::MessageID;
my $curproc = { config => { address_for_post => 'elena@fml.org' }};
my $args = {};
print $obj->gen_id($curproc, $args), "\n";
print $obj->gen_id($curproc, $args), "\n";
print $obj->gen_id($curproc, $args), "\n";
}
|
