view release on metacpan or  search on metacpan

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

	{	$extension ||= $thingy->subfolderExtension;
		$dir = $thingy->filename;
	}
	else
	{	$extension ||= $default_sub_extension;
		$dir = $class->folderToFilename($folder, $folderdir, $extension);
	}

	my $real  = -d $dir ? $dir : "$dir$extension";
	opendir my $dh, $real or return ();

	# Some files have to be removed because they are created by all
	# kinds of programs, but are no folders.

	my @entries = grep !m/\.lo?ck$|^\./, readdir $dh;
	closedir $dh;

	# Look for files in the folderdir.  They should be readable to
	# avoid warnings for usage later.  Furthermore, if we check on
	# the size too, we avoid a syscall especially to get the size
	# of the file by performing that check immediately.

	my %folders;  # hash to immediately un-double names.

	foreach my $b (@entries)
	{	my $entry = catfile $real, $b;
		if( -f $entry )
		{	next if $args{skip_empty} && ! -s _;
			next if $args{check} && !$class->foundIn($entry);
			$folders{$b}++;
		}
		elsif( -d _ )
		{	# Directories may create fake folders.
			if($args{skip_empty})
			{	opendir my $dh, $entry or next;
				my @sub = grep !/^\./, readdir $dh;
				closedir $dh;
				@sub or next;
			}

			my $folder = $b =~ s/$extension$//r;
			$folders{$folder}++;
		}
	}

	map +(m/(.*)/ && $1), keys %folders;   # untained names
}

sub openRelatedFolder(@)
{	my $self = shift;
	$self->SUPER::openRelatedFolder(subfolder_extension => $self->subfolderExtension, @_);
}

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

sub folderToFilename($$;$)
{	my ($thingy, $name, $folderdir, $extension) = @_;
	$extension ||= ref $thingy ? $thingy->subfolderExtension : $default_sub_extension;

	$name     =~ s#^=#$folderdir/#;
	my @parts = split m!/!, $name;

	my $real  = shift @parts;
	$real     = '/' if $real eq '';

	if(@parts)
	{	my $file  = pop @parts;
		$real = catdir  $real.(-d $real ? '' : $extension), $_ for @parts;
		$real = catfile $real.(-d $real ? '' : $extension), $file;
	}

	$real;
}


sub foundIn($@)
{	my $class = shift;
	my $name  = @_ % 2 ? shift : undef;
	my %args  = @_;
	$name   ||= $args{folder} or return;

	my $folderdir = $args{folderdir} || $default_folder_dir;
	my $extension = $args{subfolder_extension} || $default_sub_extension;
	my $filename  = $class->folderToFilename($name, $folderdir, $extension);

	if(-d $filename)
	{	# Maildir and MH Sylpheed have a 'new' sub-directory
		return 0 if -d catdir $filename, 'new';
		if(opendir my $dir, $filename)
		{	my @f = grep !/^\./, readdir $dir;   # skip . .. and hidden
			return 0 if @f && ! grep /\D/, @f;              # MH
			closedir $dir;
		}

		return 0                                             # Other MH
			if -f "$filename/.mh_sequences";

		return 1;      # faked empty Mbox sub-folder (with subsub-folders?)
	}

	return 0 unless -f $filename;
	return 1 if -z $filename;               # empty folder is ok

	open my $file, '<:raw', $filename or return 0;
	local $_;
	while(<$file>)
	{	next if /^\s*$/;                    # skip empty lines
		$file->close;
		return substr($_, 0, 5) eq 'From '; # found Mbox separator?
	}

	return 1;
}

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

1;