view release on metacpan or  search on metacpan

lib/Mail/Box/File.pm  view on Meta::CPAN

	  :   return ();

	my $folder   = $class->new(lock_type => 'NONE', @_, access => 'w+')
		or return ();

	my $filename = $folder->filename;
	open my $out, '>>', $filename
		or fault __x"cannot append messages to folder file {file}.", file => $filename;

	my $msgtype = $class.'::Message';
	my @coerced;

	foreach my $msg (@messages)
	{	my $coerced = $msg->isa($msgtype) ? $msg : $msgtype->coerce($msg->can('clone') ? $msg->clone : $msg);
		$coerced->write($out);
		push @coerced, $coerced;
	}

	my $ok = $folder->close;
	$out->close && $ok
		or return ();

	@coerced;
}

#--------------------

sub parser()
{	my $self   = shift;
	return $self->{MBF_parser} if defined $self->{MBF_parser};

	my $source = $self->filename;
	my $mode   = $self->access || 'r';
	$mode      = 'r+' if $mode eq 'rw' || $mode eq 'a';

	my $parser = $self->{MBF_parser} = Mail::Box::Parser->new(
		filename          => $source,
		mode              => $mode,
		trusted           => $self->isTrusted,
		fix_header_errors => $self->fixHeaders,
	);
	$parser->pushSeparator('From ');
	$parser;
}

sub readMessages(@)
{	my ($self, %args) = @_;

	$self->messageCreateOptions(
		$args{message_type},
		folder     => $self,
		head_type  => $args{head_type},
		field_type => $args{field_type},
		trusted    => $args{trusted},
	);

	$self->updateMessages;
}


sub updateMessages(@)
{	my ($self, %args) = @_;
	my $parser   = $self->parser or return;

	# On a directory, simulate an empty folder with only subfolders.
	my $filename = $self->filename;
	return $self if -d $filename;

	if(my $last  = $self->message(-1))
	{	(undef, my $end) = $last->fileLocation;
		$parser->filePosition($end);
	}

	my ($type, @msgopts) = $self->messageCreateOptions;
	my $count    = 0;

	while(1)
	{	my $message = $type->new(@msgopts);
		$message->readFromParser($parser) or last;
		$self->storeMessage($message);
		$count++;
	}

	trace "found $count new messages in $filename";
	$self;
}


sub messageCreateOptions(@)
{	my ($self, @options) = @_;
	if(@options)
	{	blessed $_ && (ref $_) =~ m/^Mail::/ && weaken $_ for @options;
		$self->{MBF_create_options} = \@options;
	}

	@{$self->{MBF_create_options}};
}


sub moveAwaySubFolder($$)
{	my ($self, $dir, $extension) = @_;

	move $dir, $dir.$extension
		or fault __x"cannot move away sub-folder {dir}", dir => $dir;

	$self;
}

sub delete(@)
{	my $self = shift;
	$self->SUPER::delete(@_);
	unlink $self->filename;
}


sub writeMessages($)
{	my ($self, $args) = @_;

	my $filename = $self->filename;
	if( ! @{$args->{messages}} && $self->removeEmpty)
	{	unlink $filename