File Coverage

blib/lib/Mail/Box/Dir.pm

Criterion	Covered	Total	%
statement	59	64	92.1
branch	12	16	75.0
condition	10	20	50.0
subroutine	18	20	90.0
pod	6	7	85.7
total	105	127	82.6

# This code is part of Perl distribution Mail-Box version 4.01.
# The POD got stripped from this file by OODoc version 3.05.
# For contributors see file ChangeLog.

# This software is copyright (c) 2001-2025 by Mark Overmeer.

# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later


package Mail::Box::Dir;{
our $VERSION = '4.01';
}

use parent 'Mail::Box';

use strict;
use warnings;

use Log::Report      'mail-box', import => [ qw/__x error warning/ ];

use Mail::Box::Dir::Message        ();
use Mail::Message::Body::Lines     ();
use Mail::Message::Body::File      ();
use Mail::Message::Body::Delayed   ();
use Mail::Message::Body::Multipart ();
use Mail::Message::Head            ();
use Mail::Message::Head::Delayed   ();

use File::Spec::Functions           qw/rel2abs/;

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

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

	$args->{body_type} //= sub { 'Mail::Message::Body::Lines' };
	$self->SUPER::init($args);

	my $class     = ref $self;
	my $directory = $self->{MBD_directory} = $args->{directory} || $self->directory;

		if(-d $directory) {;}
	elsif($args->{create} && $class->create($directory, %$args)) { ;}
	else
	{	error __x"no directory {dir} for folder of type.", dir => $directory, type => $class;
	}

	# About locking

	my $lf = $args->{lock_file} // '.lock';
	$self->locker->filename(rel2abs $lf, $directory);

	# Check if we can write to the folder, if we need to.

	if($self->writable && -e $directory && ! -w $directory)
	{	warning __x"folder directory {dir} is write-protected.", dir => $directory;
		$self->access('r');
	}

	$self;
}

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

sub organization() { 'DIRECTORY' }

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

sub directory()
{	my $self = shift;
	$self->{MBD_directory} ||= $self->folderToDirectory($self->name, $self->folderdir);
}

sub nameOfSubFolder($;$)
{	my ($thing, $name) = (shift, shift);
	my $parent = @_ ? shift : ref $thing ? $thing->directory : undef;
	defined $parent ? "$parent/$name" : $name;
}

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

sub folderToDirectory($$)
{	my ($class, $name, $folderdir) = @_;
	my $dir = ($name =~ m#^=\/?(.*)# ? "$folderdir/$1" : $name);
	$dir =~ s!/$!!r;
}

sub storeMessage($)
{	my ($self, $message) = @_;
	$self->SUPER::storeMessage($message);
	my $fn = $message->filename or return $message;
	$self->{MBD_by_fn}{$fn} = $message;
}


sub messageInFile($) { $_[0]->{MBD_by_fn}{$_[1]} }


sub readMessageFilenames() { $_[0]->notImplemented }

1;