Coro/mymap/mymap.pl

use PApp::SQL;

$PApp::SQL::DBH = DBI->connect("DBI:mysql:mymap")
   or die "database: $!";

$CR = "\015";
$CRLF = "\015\012";

$F_D        = 0x01;
$F_deleted  = 0x02;
$F_flagged  = 0x04;
$F_answered = 0x08;
$F_seen     = 0x10;
$F_draft    = 0x20;

sub find_uid {
   sql_fetch "select id from user where name = ?", $_[0];
}

sub find_bid {
   sql_fetch "select id from box where uid = ? and name = ?", $_[0], $_[1];
}

my $skip_from = qr{^pcg\@goof.com$}i;
my $skip_to   = qr{(\.laendle|plan9\.de|schmorp\.de)$}i;

sub _raddr {
   $_raddr{$_[0]} ||= eval { (parse Mail::Address $_[0])[0]->address };
}

sub deliver_mail {
   my ($bid, $env_from, $env_to, $date, $flags, $head, $body) = @_;

   sql_exec "lock tables box write, msg write";
   unless (sql_exists "msg where bid = ? and env_from = ? and env_to = ? and ntime = ? and header = ? and body = ?",
                      $bid, $env_from, $env_to,$date, $head, $body) {
      sql_exec "insert into msg (bid, env_from, env_to, ntime, flags, header, body)
                       values (?,?,?,?,?,?,?)",
               $bid, $env_from, $env_to, $date, $flags, $head, $body;
   }
   sql_exec "unlock tables";
}

# import Mail::Message object into the given folder
sub import_mailmsg {
   my ($bid, $msg) = @_;

   my $body = join "", @{$msg->body};
   $msg = $msg->head;
   $msg->unfold;

   my ($from, $to, $date);

   if ($from = $msg->get("Mail-From")) {
      $msg->delete("Mail-From");
      ($from, $date) = split /\s+/, $from, 2;
   }

   undef $from if $from =~ $skip_from;

   $from ||= $msg->get("Sender") || $msg->get("From");

   $from = _raddr $from;

   $to = _raddr $msg->get("To");
   for (my $idx = 0; $idx < 29; $idx++) {
      my $rcvd = extract Mail::Field "Received", $msg, $idx
         or last;
      $rcvd = $rcvd->parse_tree;
      $date ||= $rcvd->{date_time}{date_time};
      my $xto = _raddr $rcvd->{for}{for}
         or next;
      $to = $xto;
      last unless $to =~ $skip_to;
   }

   my $status = $msg->get("Status"); $msg->delete("Status");

   $date = str2time($date);

   my @flags;
   push @flags, "seen"     if $status =~ /O/i;
   push @flags, "deleted"  if $status =~ /D/i;
   push @flags, "answered" if $status =~ /R/i;
   push @flags, "flagged"  if $status =~ /!/i;
   push @flags, "recent"   if !$status;

   $msg->delete("Content-Length");

   my $head = $msg->as_string;

   for ($body, $head) {
      s/\n/$CRLF/o;
   }
   
   deliver_mail ($bid, $from, $to, $date, (join ",", @flags), $head, $body);
}

sub flags2bitmask {
   my $mask = 0;

   for (@_) {
      $mask |= $F_D        if /^\\D$/i;
      $mask |= $F_deleted  if /^\\deleted$/i;
      $mask |= $F_flagged  if /^\\flagged$/i;
      $mask |= $F_answered if /^\\answered$/i;
      $mask |= $F_seen     if /^\\seen$/i;
      $mask |= $F_draft    if /^\\draft$/i;
   }

   $mask;
}
Revision:	1.1
Committed:	Thu Aug 9 02:57:54 2001 UTC (23 years, 1 month ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	rel-2_5, rel-4_91, rel-4_22, rel-4_21, rel-4_0, rel-4_3, rel-3_41, rel-5_151, rel-4_13, rel-4_11, rel-5_1, rel-5_0, rel-6_0, rel-6_5, rel-4_748, rel-3_55, rel-4_8, rel-4_9, rel-3_51, rel-4_741, rel-4_743, rel-4_742, rel-6_10, rel-4_744, rel-4_747, rel-6_13, rel-4_01, rel-4_03, rel-4_02, rel-2_0, rel-2_1, rel-1_1, rel-1_0, rel-1_9, rel-1_2, rel-3_6, rel-3_62, rel-3_63, rel-3_61, rel-1_5, rel-1_4, rel-1_7, rel-1_6, rel-3_4, rel-6_09, rel-6_08, rel-6_07, rel-6_06, rel-6_05, rel-6_04, rel-6_03, rel-6_02, rel-6_01, rel-5_161, rel-3_1, rel-4_74, rel-4_71, rel-4_72, rel-4_73, rel-5_371, rel-5_372, rel-6_512, rel-6_513, rel-6_511, rel-6_514, rel-5_22, rel-5_23, rel-5_24, rel-5_25, rel-6_32, rel-6_33, rel-6_31, rel-6_36, rel-6_37, rel-5_162, rel-5_2, rel-6_38, rel-6_39, rel-4_802, rel-4_803, rel-3_5, rel-4_801, rel-3_3, rel-3_2, rel-4_804, rel-3_0, rel-5_37, rel-5_36, rel-4_479, rel-6_23, rel-3_01, rel-6_29, rel-6_28, rel-6_46, rel-4_50, rel-4_51, rel-6_45, rel-4_4, rel-3_11, rel-1_31, rel-4_45, rel-6_51, rel-6_52, rel-6_53, rel-6_54, rel-6_55, rel-6_56, rel-6_57, rel-4_745, rel-4_901, rel-4_49, rel-4_48, rel-4_1, rel-4_2, rel-4_746, rel-5_11, rel-5_12, rel-5_15, rel-5_14, rel-5_17, rel-5_16, stack_sharing, rel-4_47, rel-4_46, rel-4_7, rel-3_501, rel-6_43, rel-6_42, rel-6_41, rel-6_47, rel-5_132, rel-5_131, rel-6_44, rel-6_49, rel-6_48, rel-4_911, rel-4_912, rel-4_31, rel-4_32, rel-4_33, rel-4_34, rel-4_35, rel-4_36, rel-4_37, HEAD
Log Message:	* empty log message *
#	Content
1	use PApp::SQL;
2
3	$PApp::SQL::DBH = DBI->connect("DBI:mysql:mymap")
4	or die "database: $!";
5
6	$CR = "\015";
7	$CRLF = "\015\012";
8
9	$F_D = 0x01;
10	$F_deleted = 0x02;
11	$F_flagged = 0x04;
12	$F_answered = 0x08;
13	$F_seen = 0x10;
14	$F_draft = 0x20;
15
16	sub find_uid {
17	sql_fetch "select id from user where name = ?", $_[0];
18	}
19
20	sub find_bid {
21	sql_fetch "select id from box where uid = ? and name = ?", $_[0], $_[1];
22	}
23
24	my $skip_from = qr{^pcg\@goof.com$}i;
25	my $skip_to = qr{(\.laendle\|plan9\.de\|schmorp\.de)$}i;
26
27	sub _raddr {
28	$_raddr{$_[0]} \|\|= eval { (parse Mail::Address $_[0])[0]->address };
29	}
30
31	sub deliver_mail {
32	my ($bid, $env_from, $env_to, $date, $flags, $head, $body) = @_;
33
34	sql_exec "lock tables box write, msg write";
35	unless (sql_exists "msg where bid = ? and env_from = ? and env_to = ? and ntime = ? and header = ? and body = ?",
36	$bid, $env_from, $env_to,$date, $head, $body) {
37	sql_exec "insert into msg (bid, env_from, env_to, ntime, flags, header, body)
38	values (?,?,?,?,?,?,?)",
39	$bid, $env_from, $env_to, $date, $flags, $head, $body;
40	}
41	sql_exec "unlock tables";
42	}
43
44	# import Mail::Message object into the given folder
45	sub import_mailmsg {
46	my ($bid, $msg) = @_;
47
48	my $body = join "", @{$msg->body};
49	$msg = $msg->head;
50	$msg->unfold;
51
52	my ($from, $to, $date);
53
54	if ($from = $msg->get("Mail-From")) {
55	$msg->delete("Mail-From");
56	($from, $date) = split /\s+/, $from, 2;
57	}
58
59	undef $from if $from =~ $skip_from;
60
61	$from \|\|= $msg->get("Sender") \|\| $msg->get("From");
62
63	$from = _raddr $from;
64
65	$to = _raddr $msg->get("To");
66	for (my $idx = 0; $idx < 29; $idx++) {
67	my $rcvd = extract Mail::Field "Received", $msg, $idx
68	or last;
69	$rcvd = $rcvd->parse_tree;
70	$date \|\|= $rcvd->{date_time}{date_time};
71	my $xto = _raddr $rcvd->{for}{for}
72	or next;
73	$to = $xto;
74	last unless $to =~ $skip_to;
75	}
76
77	my $status = $msg->get("Status"); $msg->delete("Status");
78
79	$date = str2time($date);
80
81	my @flags;
82	push @flags, "seen" if $status =~ /O/i;
83	push @flags, "deleted" if $status =~ /D/i;
84	push @flags, "answered" if $status =~ /R/i;
85	push @flags, "flagged" if $status =~ /!/i;
86	push @flags, "recent" if !$status;
87
88	$msg->delete("Content-Length");
89
90	my $head = $msg->as_string;
91
92	for ($body, $head) {
93	s/\n/$CRLF/o;
94	}
95
96	deliver_mail ($bid, $from, $to, $date, (join ",", @flags), $head, $body);
97	}
98
99	sub flags2bitmask {
100	my $mask = 0;
101
102	for (@_) {
103	$mask \|= $F_D if /^\\D$/i;
104	$mask \|= $F_deleted if /^\\deleted$/i;
105	$mask \|= $F_flagged if /^\\flagged$/i;
106	$mask \|= $F_answered if /^\\answered$/i;
107	$mask \|= $F_seen if /^\\seen$/i;
108	$mask \|= $F_draft if /^\\draft$/i;
109	}
110
111	$mask;
112	}