view release on metacpan or  search on metacpan

lib/Sendmail/Queue/Qf.pm  view on Meta::CPAN

	if ($iterations >= 3600 ) {
		die q{Could not create queue file; too many iterations};
	}

	return 1;
}

# _tz_diff and _format_rfc2822_date borrowed from Email::Date.  Why?
# Because they depend on Date::Parse and Time::Piece, and I don't want
# to add them as dependencies.
# Similar functions exist in MIMEDefang as well
sub _tz_diff
{
	my ($time) = @_;

	my $diff  =   Time::Local::timegm(localtime $time)
	            - Time::Local::timegm(gmtime    $time);

	my $direc = $diff < 0 ? '-' : '+';
	$diff     = abs $diff;
	my $tz_hr = int( $diff / 3600 );
	my $tz_mi = int( $diff / 60 - $tz_hr * 60 );

	return ($direc, $tz_hr, $tz_mi);
}

sub _format_rfc2822_date
{
	my ($time) = @_;
	$time = time unless defined $time;

	my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime $time;
	my $day   = (qw[Sun Mon Tue Wed Thu Fri Sat])[$wday];
	my $month = (qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec])[$mon];
	$year += 1900;

	my ($direc, $tz_hr, $tz_mi) = _tz_diff($time);

	sprintf '%s, %d %s %d %02d:%02d:%02d %s%02d%02d',
	    $day, $mday, $month, $year, $hour, $min, $sec, $direc, $tz_hr, $tz_mi;
}

=head2 synthesize_received_header ( )

Create a properly-formatted Received: header for this message, using
any data available from the object.

The generated header is saved internally as 'received_header'.

=cut

sub synthesize_received_header
{
	my ($self) = @_;

	my $g = Mail::Header::Generator->new();

	my $user = $self->get_user();
	if(!$user) {
		$user = getpwuid($>);
	}

	$self->{received_header} = $g->received({
		helo           => $self->get_helo(),
		hostname       => $self->get_local_hostname(),
		product_name   => $self->get_product_name(),
		protocol       => ($self->get_protocol || ''),
		queue_id       => $self->get_queue_id(),
		recipients     => $self->get_recipients(),
		relay_address  => $self->get_relay_address(),
		relay_hostname => $self->get_relay_hostname(),
		sender         => $self->get_sender(),
		timestamp      => $self->get_timestamp(),
		user           => $user
	});

	return $self->{received_header};
}

=head2 get_queue_filename

Return the full path name of this queue file.

Will return undef if no queue ID exists, and die if queue directory is
unset.

=cut

sub get_queue_filename
{
	my ($self) = @_;

	if( ! $self->get_queue_directory ) {
		die q{queue directory not set};
	}

	if( ! $self->get_queue_id ) {
		return undef;
	}

	return File::Spec->catfile( $self->get_queue_directory(), 'qf' . $self->get_queue_id() );
}

=head2 add_recipient ( $recipient [, $recipient, $recipient ] )

Add one or more recipients to this object.

=cut

sub add_recipient
{
	my ($self, @recips) = @_;

	push @{$self->{recipients}}, @recips;
}

=head2 write ( )

Writes a qfXXXXXXX file using the object's data.