#-*- perl -*-
#
# Copyright (C) 2003,2004,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.
#
# $FML: Info.pm,v 1.8 2006/02/22 12:16:31 fukachan Exp $
#
package FML::User::Info;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD
$debug $default_expire_period);
use Carp;
=head1 NAME
FML::User::Info - maintain user information.
=head1 SYNOPSIS
use FML::User::Info;
my $data = new FML::User::Info $curproc;
$data->set_subscribe_date($address, time);
=head1 DESCRIPTION
This class maintains user information.
=head1 METHODS
=head2 new()
constuctor.
=cut
# Descriptions: constructor.
# Arguments: OBJ($self) OBJ($curproc)
# Side Effects: create object
# Return Value: OBJ
sub new
{
my ($self, $curproc) = @_;
my ($type) = ref($self) || $self;
my $me = { _curproc => $curproc };
use FML::User::DB;
$me->{ _db } = new FML::User::DB $curproc;
return bless $me, $type;
}
=head2 set_header_info($address)
top level entrance to update user database based on header
information.
=cut
# Descriptions: update user database based on header information.
# Arguments: OBJ($self) STR($address)
# Side Effects: update db.
# Return Value: none
sub set_header_info
{
my ($self, $address) = @_;
my $curproc = $self->{ _curproc };
my $header = $curproc->incoming_message_header();
my $from = $header->get('from');
# For example, we record the following user information if could.
# See passwd(5).
# class User's login class.
# change Password change time.
# expire Account expiration time.
# gecos General information about the user.
# 1. GECOS INFORMATION
use Mail::Address;
my (@addr_list) = Mail::Address->parse($from);
for my $_addr (@addr_list) {
my $addr = $_addr->address();
my $gecos = $_addr->comment();
if ($gecos) { $self->set_gecos($addr, $gecos);}
}
}
=head1 GECOS INFO MANIPULATION
=head2 set_gecos($address, $gecos)
update gecos database.
=head2 get_gecos($address)
get information from gecos database.
=cut
# Descriptions: update gecos database.
# Arguments: OBJ($self) STR($address) STR($gecos)
# Side Effects: update gecos database.
# Return Value: none
sub set_gecos
{
my ($self, $address, $gecos) = @_;
my $db = $self->{ _db };
$db->add("gecos", $address, $gecos);
}
# Descriptions: get gecos information from database.
# Arguments: OBJ($self) STR($address)
# Side Effects: none
# Return Value: STR
sub get_gecos
{
my ($self, $address) = @_;
my $db = $self->{ _db };
$db->get("gecos", $address);
}
=head1 "WHEN SUBSCRIBED" INFO MANIPULATION
=head2 set_subscribe_date($address, $subscribe_date)
update subscribe_date database.
=head2 get_subscribe_date($address)
get information from subscribe_date database.
=cut
# Descriptions: update subscribe_date database.
# Arguments: OBJ($self) STR($address) STR($subscribe_date)
# Side Effects: update subscribe_date database.
# Return Value: none
sub set_subscribe_date
{
my ($self, $address, $subscribe_date) = @_;
my $db = $self->{ _db };
$db->add("subscribe_date", $address, $subscribe_date);
}
# Descriptions: get information from subscribe_date database.
# Arguments: OBJ($self) STR($address)
# Side Effects: none
# Return Value: STR
sub get_subscribe_date
{
my ($self, $address) = @_;
my $db = $self->{ _db };
$db->get("subscribe_date", $address);
}
=head1 CODING STYLE
See C on fml coding style guide.
=head1 AUTHOR
Ken'ichi Fukamachi
=head1 COPYRIGHT
Copyright (C) 2003,2004,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
FML::User::Info appeared in fml8 mailing list driver package.
See C for more details.
=cut
1;