#-*- perl -*- # # Copyright (C) 2001,2002,2003,2004 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. # # $FML: MessageID.pm,v 1.20 2004/01/02 14:50:31 fukachan Exp $ # package FML::Header::MessageID; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD $Counter); use Carp; =head1 NAME FML::Header::MessageID - manupulate message-id =head1 SYNOPSIS use FML::Header::MessageID; my $xargs = { directory => $dir }; my $db = FML::Header::MessageID->new->db_open($xargs); if (defined $db) { # we can tind the $mid in the past message-id cache ? $dup = $db->{ $mid }; Log( "message-id duplicated" ) if $dup; # save the current id $db->{ $mid } = 1; } =head1 DESCRIPTION manipulate Message-Id database. =head1 METHODS =head2 new($args) standard constructor. =cut # Descriptions: standard constructor. # Arguments: OBJ($self) HASH_REF($args) # Side Effects: none # Return Value: OBJ sub new { my ($self, $args) = @_; my ($type) = ref($self) || $self; my $me = {}; return bless $me, $type; } =head2 db_open($db_args) open db and return HASH_REF for the db access. =head2 db_close() =cut # Descriptions: open message-id database # Arguments: OBJ($self) HASH_REF($db_args) # Side Effects: open database. # Return Value: HASH_ERF sub db_open { my ($self, $db_args) = @_; my $dir = $db_args->{ 'directory' } || ''; my $mode = 'temporal'; my $days = 14; if ($dir) { unless (-d $dir) { # XXX-TODO: dir_mode is hard-coded ? my $dir_mode = $self->{ _dir_mode } || 0700; use File::Path; mkpath( [ $dir ], 0, $dir_mode ); } my %db = (); use Tie::JournaledDir; tie %db, 'Tie::JournaledDir', { dir => $dir }; $self->{ _db } = \%db; return \%db; } undef; } # Descriptions: close message-id database (dummy). # Arguments: OBJ($self) # Side Effects: none # Return Value: none sub db_close { } =head2 get($key) get value for the key $key in message-id database. return '' if not found nor defined. =head2 set($key, $value) set value for the key $key in message-id database. =cut # Descriptions: get value for $key. # Arguments: OBJ($self) STR($key) # Side Effects: none # Return Value: STR sub get { my ($self, $key) = @_; my $db = $self->{ _db }; if (defined $db) { return( $db->{ $key } || '' ); } else { return ''; } } # Descriptions: set value for $key. # Arguments: OBJ($self) STR($key) STR($value) # Side Effects: none # Return Value: STR sub set { my ($self, $key, $value) = @_; my $db = $self->{ _db }; if (defined $db) { $db->{ $key } = $value; return $value; } return undef; } =head2 gen_id($config) generate and return a new message-id. =cut # Descriptions: generate new message-id used in reply message # Arguments: OBJ($self) OBJ($config) # Side Effects: counter increment # Return Value: STR sub gen_id { my ($self, $config) = @_; # XXX-TODO: if $config->{ address_for_post } undefined ? $Counter++; return "<".time.".$$.$Counter." . $config->{ address_for_post } . ">"; } =head1 CODING STYLE See C on fml coding style guide. =head1 AUTHOR Ken'ichi Fukamachi =head1 COPYRIGHT Copyright (C) 2001,2002,2003,2004 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 FML::Header::MessageID first appeared in fml8 mailing list driver package. See C for more details. =cut 1;