Mail-Box-3.012/0000755000175000001440000000000015112047463013650 5ustar00markovusers00000000000000Mail-Box-3.012/lib/0000755000175000001440000000000015112047462014415 5ustar00markovusers00000000000000Mail-Box-3.012/lib/Mail/0000755000175000001440000000000015112047462015277 5ustar00markovusers00000000000000Mail-Box-3.012/lib/Mail/Box/0000755000175000001440000000000015112047462016027 5ustar00markovusers00000000000000Mail-Box-3.012/lib/Mail/Box/Locker/0000755000175000001440000000000015112047462017246 5ustar00markovusers00000000000000Mail-Box-3.012/lib/Mail/Box/Locker/FcntlLock.pod0000644000175000001440000001247615112047446021645 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::Locker::FcntlLock - lock a folder using File::FcntlLock =head1 INHERITANCE Mail::Box::Locker::FcntlLock is a Mail::Box::Locker is a Mail::Reporter =head1 SYNOPSIS See Mail::Box::Locker =head1 DESCRIPTION This locker object is uses File::FcntlLock, and was contributed by Jim in Aus. It is close to L, but does work on more systems, for instance Darwin. You will need to install File::FcntlLock separately: there is no dependency to it by the MailBox distribution. Extends L<"DESCRIPTION" in Mail::Box::Locker|Mail::Box::Locker/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Locker|Mail::Box::Locker/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Locker|Mail::Box::Locker/"Constructors">. =over 4 =item $class-EB(%options) Inherited, see L -Option --Defined in --Default expires Mail::Box::Locker 1 hour file Mail::Box::Locker undef folder Mail::Box::Locker > log Mail::Reporter 'WARNINGS' method Mail::Box::Locker FcntlLock timeout Mail::Box::Locker 10 trace Mail::Reporter 'WARNINGS' =over 2 =item expires => $seconds =item file => $file =item folder => $folder =item log => LEVEL =item method => $name|CLASS|\@names =item timeout => $seconds|'NOTIMEOUT' =item trace => LEVEL =back =back =head2 Attributes Extends L<"Attributes" in Mail::Box::Locker|Mail::Box::Locker/"Attributes">. =over 4 =item $obj-EB( [SECONDS] ) Inherited, see L =item $obj-EB( [$filename] ) Inherited, see L =item $obj-EB( [$folder] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [SECONDS] ) Inherited, see L =back =head2 Locking Extends L<"Locking" in Mail::Box::Locker|Mail::Box::Locker/"Locking">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Box::Locker|Mail::Box::Locker/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Box::Locker|Mail::Box::Locker/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Warning: Folder $folder already lockf'd Cast by C =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Error: Unable to check lock file $file for $folder: $! To check whether the filename is used to flock a folder, the file must be opened. Apparently this fails, which does not mean that the folder is locked neither that it is unlocked. Cast by C =item Error: Unable to open FcntlLock lock file $file for $folder: $! For FcntlLock style locking, a C<$folder> it must be opened, which does not succeed for the specified reason. Cast by C =item Error: Will never get a FcntlLock lock at $file for $folder: $! Tried to lock the C<$folder>, but it did not succeed. The error code received from the OS indicates that it will not succeed ever, so we do not need to try again. Cast by C =back =head1 SEE ALSO This module is part of Mail-Box version 3.012, built on November 27, 2025. Website: F =head1 LICENSE 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. Mail-Box-3.012/lib/Mail/Box/Locker/DotLock.pm0000644000175000001440000000513615112047445021151 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::Locker::DotLock;{ our $VERSION = '3.012'; } use parent 'Mail::Box::Locker'; use strict; use warnings; use Carp; use File::Spec::Functions qw/catfile/; use Errno qw/EEXIST/; use Fcntl qw/O_CREAT O_EXCL O_WRONLY O_NONBLOCK/; #-------------------- sub init($) { my ($self, $args) = @_; $args->{file} = $args->{dotlock_file} if $args->{dotlock_file}; $self->SUPER::init($args); } sub name() { 'DOTLOCK' } #-------------------- sub folder(;$) { my $self = shift; @_ && $_[0] or return $self->SUPER::folder; my $folder = shift; unless(defined $self->filename) { my $org = $folder->organization; my $filename = $org eq 'FILE' ? $folder->filename . '.lock' : $org eq 'DIRECTORY'? catfile($folder->directory, '.lock') : croak "Need lock file name for DotLock."; $self->filename($filename); } $self->SUPER::folder($folder); } #-------------------- sub _try_lock($) { my ($self, $lockfile) = @_; return if -e $lockfile; my $flags = $^O eq 'MSWin32' ? O_CREAT|O_EXCL|O_WRONLY : O_CREAT|O_EXCL|O_WRONLY|O_NONBLOCK; my $lock; sysopen $lock, $lockfile, $flags, 0600 and $lock->close, return 1; $! == EEXIST or $self->log(ERROR => "lockfile $lockfile can never be created: $!"), return 0; 1; } sub unlock() { my $self = shift; $self->hasLock or return $self; my $lock = $self->filename; unlink $lock or $self->log(WARNING => "Couldn't remove lockfile $lock: $!"); $self->SUPER::unlock; $self; } sub lock() { my $self = shift; my $lockfile = $self->filename; $self->hasLock and $self->log(WARNING => "Folder already locked with file $lockfile"), return 1; my $timeout = $self->timeout; my $end = $timeout eq 'NOTIMEOUT' ? -1 : $timeout; my $expire = $self->expires/86400; # in days for -A while(1) { return $self->SUPER::lock if $self->_try_lock($lockfile); if(-e $lockfile && -A $lockfile > $expire) { unlink $lockfile or $self->log(ERROR => "Failed to remove expired lockfile $lockfile: $!"), last; $self->log(WARNING => "Removed expired lockfile $lockfile"); redo; } last unless --$end; sleep 1; } return 0; } sub isLocked() { -e shift->filename } 1; Mail-Box-3.012/lib/Mail/Box/Locker/Multi.pod0000644000175000001440000001245115112047446021051 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::Locker::Multi - lock a folder in all ways which work =head1 INHERITANCE Mail::Box::Locker::Multi is a Mail::Box::Locker is a Mail::Reporter =head1 SYNOPSIS See Mail::Box::Locker =head1 DESCRIPTION The C<::Multi> locker locks a folder in each way it can. This way, the chance is highest that any other program will leave the folder alone during our access to it. NFS-lock and Flock are tried. More may be added when the ways to lock are extended. DotLock overlaps with NFS-lock, but NFS-lock is safer, so that version is preferred. Extends L<"DESCRIPTION" in Mail::Box::Locker|Mail::Box::Locker/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Locker|Mail::Box::Locker/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Locker|Mail::Box::Locker/"Constructors">. =over 4 =item $class-EB(%options) You may also pass all C<%options> understood by the initiated lockers used by the multi locker. Improves base, see L -Option --Defined in --Default expires Mail::Box::Locker 1 hour file Mail::Box::Locker undef folder Mail::Box::Locker > log Mail::Reporter 'WARNINGS' method Mail::Box::Locker 'MULTI' timeout Mail::Box::Locker 10 trace Mail::Reporter 'WARNINGS' use =over 2 =item expires => $seconds =item file => $file =item folder => $folder =item log => LEVEL =item method => $name|CLASS|\@names =item timeout => $seconds|'NOTIMEOUT' =item trace => LEVEL =item use => ARRAY-of-(NAMES|LOCKER) Array of locker type NAMES or LOCKER objects to be used to lock one folder. The type NAMES are converted into objects. When you create your own LOCKER objects, be sure to set the timeout very short (preferably to 1). Some locking types are not available on some platforms, so they will not be excluded from the default list (NFS POSIX Flock). =back ยป example: using a subset of multi-lockers my $locker = Mail::Box::Locker::Multi->new(use => ['DOTLOCK','FLOCK']); =back =head2 Attributes Extends L<"Attributes" in Mail::Box::Locker|Mail::Box::Locker/"Attributes">. =over 4 =item $obj-EB( [SECONDS] ) Inherited, see L =item $obj-EB( [$filename] ) Inherited, see L =item $obj-EB( [$folder] ) Inherited, see L =item $obj-EB() Returns a list with all locker objects used by this object. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [SECONDS] ) Inherited, see L =back =head2 Locking Extends L<"Locking" in Mail::Box::Locker|Mail::Box::Locker/"Locking">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB($folder) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Box::Locker|Mail::Box::Locker/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Box::Locker|Mail::Box::Locker/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =back =head1 SEE ALSO This module is part of Mail-Box version 3.012, built on November 27, 2025. Website: F =head1 LICENSE 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. Mail-Box-3.012/lib/Mail/Box/Locker/Flock.pod0000644000175000001440000001312015112047446021007 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::Locker::Flock - lock a folder using kernel file-locking =head1 INHERITANCE Mail::Box::Locker::Flock is a Mail::Box::Locker is a Mail::Reporter =head1 SYNOPSIS See the generic Mail::Box::Locker interface =head1 DESCRIPTION The C<::Flock> object locks the folder by creating an exclusive lock on the file using the kernel's C facilities. This lock is created on a separate file-handle to the folder file, so not the handle which is reading. File locking does not work in some situations, for instance for operating systems do not support C. Extends L<"DESCRIPTION" in Mail::Box::Locker|Mail::Box::Locker/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Locker|Mail::Box::Locker/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Locker|Mail::Box::Locker/"Constructors">. =over 4 =item $class-EB(%options) Inherited, see L -Option --Defined in --Default expires Mail::Box::Locker 1 hour file Mail::Box::Locker undef folder Mail::Box::Locker > log Mail::Reporter 'WARNINGS' method Mail::Box::Locker 'FLOCK' timeout Mail::Box::Locker 10 trace Mail::Reporter 'WARNINGS' =over 2 =item expires => $seconds =item file => $file =item folder => $folder =item log => LEVEL =item method => $name|CLASS|\@names =item timeout => $seconds|'NOTIMEOUT' =item trace => LEVEL =back =back =head2 Attributes Extends L<"Attributes" in Mail::Box::Locker|Mail::Box::Locker/"Attributes">. =over 4 =item $obj-EB( [SECONDS] ) Inherited, see L =item $obj-EB( [$filename] ) Inherited, see L =item $obj-EB( [$folder] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [SECONDS] ) Inherited, see L =back =head2 Locking Extends L<"Locking" in Mail::Box::Locker|Mail::Box::Locker/"Locking">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Acquire a lock on the folder. Improves base, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Box::Locker|Mail::Box::Locker/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Box::Locker|Mail::Box::Locker/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Warning: Folder $folder already flocked The C<$folder> is already locked, but you attempt to lock it again. The behavior of double flock's is platform dependent, and therefore should not be attempted. The second lock is ignored (but the unlock isn't). Cast by C =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Error: Unable to check lock file $filename for $folder: $! To check whether the C<$filename> is used to C a C<$folder>, the file must be opened. Apparently this fails, which does not mean that the folder is locked neither that it is unlocked. Cast by C =item Error: Unable to open flock file $file for $folder: $! For C-ing a C<$folder> it must be opened, which does not succeed for the specified reason. Cast by C =item Error: Will never get a flock at $file for $folder: $! Tried to C the C<$folder>, but it did not succeed. The error code received from the OS indicates that it will not succeed ever, so we do not need to try again. Cast by C =back =head1 SEE ALSO This module is part of Mail-Box version 3.012, built on November 27, 2025. Website: F =head1 LICENSE 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. Mail-Box-3.012/lib/Mail/Box/Locker/POSIX.pod0000644000175000001440000001331015112047446020654 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::Locker::POSIX - lock a folder using kernel file-locking =head1 INHERITANCE Mail::Box::Locker::POSIX is a Mail::Box::Locker is a Mail::Reporter =head1 SYNOPSIS See Mail::Box::Locker =head1 DESCRIPTION This locker object is created by the folder to get an exclusive lock on the file which contains the data using the kernel's POSIX facilities. This lock is created on a separate file-handle to the folder file, so not the handle which is reading. B: Not all platforms support POSIX locking (via fcntl) and not always in the same way. This implementation does not use XS to access the structure of fcntl(): it is better to use the ::FcntlLock which does. No, this implementation "guesses" the location of the bytes. Extends L<"DESCRIPTION" in Mail::Box::Locker|Mail::Box::Locker/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Locker|Mail::Box::Locker/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Locker|Mail::Box::Locker/"Constructors">. =over 4 =item $class-EB(%options) Inherited, see L -Option --Defined in --Default expires Mail::Box::Locker 1 hour file Mail::Box::Locker undef folder Mail::Box::Locker > log Mail::Reporter 'WARNINGS' method Mail::Box::Locker POSIX posix_file > timeout Mail::Box::Locker 10 trace Mail::Reporter 'WARNINGS' =over 2 =item expires => $seconds =item file => $file =item folder => $folder =item log => LEVEL =item method => $name|CLASS|\@names =item posix_file => FILENAME Alternative name for C, especially useful to avoid confusion when the multi-locker is used. =item timeout => $seconds|'NOTIMEOUT' =item trace => LEVEL =back =back =head2 Attributes Extends L<"Attributes" in Mail::Box::Locker|Mail::Box::Locker/"Attributes">. =over 4 =item $obj-EB( [SECONDS] ) Inherited, see L =item $obj-EB( [$filename] ) Inherited, see L =item $obj-EB( [$folder] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [SECONDS] ) Inherited, see L =back =head2 Locking Extends L<"Locking" in Mail::Box::Locker|Mail::Box::Locker/"Locking">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Box::Locker|Mail::Box::Locker/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Box::Locker|Mail::Box::Locker/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Warning: Folder $folder already lockf'd Cast by C =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Error: Unable to check lock file $file for $folder: $! To check whether the C<$file> is used to flock a C<$folder>, the file must be opened. Apparently this fails, which does not mean that the folder is locked neither that it is unlocked. Cast by C =item Error: Unable to open POSIX lock file $file for $folder: $! For POSIX style locking, a C<$folder> it must be opened, which does not succeed for the specified reason. Cast by C =item Error: Will never get a POSIX lock at $file for $folder: $! Tried to lock the C<$folder>, but it did not succeed. The error code received from the OS indicates that it will not succeed ever, so we do not need to try again. Cast by C =back =head1 SEE ALSO This module is part of Mail-Box version 3.012, built on November 27, 2025. Website: F =head1 LICENSE 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. Mail-Box-3.012/lib/Mail/Box/Locker/POSIX.pm0000644000175000001440000000472115112047445020513 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::Locker::POSIX;{ our $VERSION = '3.012'; } use parent 'Mail::Box::Locker'; use strict; use warnings; use Fcntl qw/F_WRLCK F_UNLCK F_SETLK/; use Errno qw/EAGAIN/; # fcntl() should not be used without XS: the below is sensitive # for changes in the structure. However, at the moment it seems # there are only two options: either SysV-style or BSD-style my $pack_pattern = $^O =~ /bsd|darwin/i ? '@20 s @256' : 's @256'; #-------------------- sub init($) { my ($self, $args) = @_; $args->{file} = $args->{posix_file} if $args->{posix_file}; $self->SUPER::init($args); } sub name() { 'POSIX' } #-------------------- sub _try_lock($) { my ($self, $file) = @_; my $p = pack $pack_pattern, F_WRLCK; $? = fcntl($file, F_SETLK, $p) || ($!+0); $?==0; } sub _unlock($) { my ($self, $file) = @_; my $p = pack $pack_pattern, F_UNLCK; fcntl $file, F_SETLK, $p; $self; } sub lock() { my $self = shift; if($self->hasLock) { my $folder = $self->folder; $self->log(WARNING => "Folder $folder already lockf'd"); return 1; } my $file = $self->filename; my $folder = $self->folder; open my $fh, '+<:raw', $file or $self->log(ERROR => "Unable to open POSIX lock file $file for $folder: $!"), return 0; my $timeout = $self->timeout; my $end = $timeout eq 'NOTIMEOUT' ? -1 : $timeout; while(1) { if($self->_try_lock($fh)) { $self->{MBLF_filehandle} = $fh; return $self->SUPER::lock; } $!==EAGAIN or $self->log(ERROR => "Will never get a POSIX lock on $file for $folder: $!"), return 0; --$end or last; sleep 1; } return 0; } sub isLocked() { my $self = shift; my $file = $self->filename; open my $fh, '<:raw', $file; unless($fh) { my $folder = $self->folder; $self->log(ERROR => "Unable to check lock file $file for $folder: $!"); return 0; } $self->_try_lock($fh)==0 or return 0; $self->_unlock($fh); $fh->close; $self->SUPER::unlock; 1; } sub unlock() { my $self = shift; $self->_unlock(delete $self->{MBLF_filehandle}) if $self->hasLock; $self->SUPER::unlock; $self; } 1; Mail-Box-3.012/lib/Mail/Box/Locker/Multi.pm0000644000175000001440000000414515112047445020703 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::Locker::Multi;{ our $VERSION = '3.012'; } use parent 'Mail::Box::Locker'; use strict; use warnings; use Carp; use Scalar::Util qw/blessed/; #-------------------- sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); my @use = exists $args->{use} ? @{delete $args->{use}} : $^O eq 'MSWin32' ? qw/Flock/ : qw/NFS FcntlLock Flock/; my (@lockers, @used); foreach my $method (@use) { if(blessed $method && $method->isa('Mail::Box::Locker')) { push @lockers, $method; push @used, ref $method =~ s/.*\:\://r; next; } my $locker = eval { Mail::Box::Locker->new(%$args, method => $method, timeout => 1) }; defined $locker or next; push @lockers, $locker; push @used, $method; } $self->{MBLM_lockers} = \@lockers; $self->log(PROGRESS => "Multi-locking via @used."); $self; } #-------------------- sub lockers() { @{ $_[0]->{MBLM_lockers}} } sub name() {'MULTI'} sub _try_lock() { my $self = shift; my @successes; foreach my $locker ($self->lockers) { unless($locker->lock) { $_->unlock for @successes; return 0; } push @successes, $locker; } 1; } #-------------------- sub unlock() { my $self = shift; $self->hasLock or return $self; $_->unlock for $self->lockers; $self->SUPER::unlock; $self; } sub lock() { my $self = shift; return 1 if $self->hasLock; my $timeout = $self->timeout; my $end = $timeout eq 'NOTIMEOUT' ? -1 : $timeout; while(1) { return $self->SUPER::lock if $self->_try_lock; last unless --$end; sleep 1; } return 0; } sub isLocked() { my $self = shift; # Try get a lock $self->_try_lock or return 0; # and release it immediately $self->unlock; 1; } 1; Mail-Box-3.012/lib/Mail/Box/Locker/Flock.pm0000644000175000001440000000421415112047445020644 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::Locker::Flock;{ our $VERSION = '3.012'; } use parent 'Mail::Box::Locker'; use strict; use warnings; use Fcntl qw/:DEFAULT :flock/; use Errno qw/EAGAIN/; #-------------------- sub name() {'FLOCK'} sub _try_lock($) { my ($self, $file) = @_; flock $file, LOCK_EX|LOCK_NB; } sub _unlock($) { my ($self, $file) = @_; flock $file, LOCK_UN; $self; } #-------------------- # 'r+' is require under Solaris and AIX, other OSes are satisfied with 'r'. my $lockfile_access_mode = ($^O eq 'solaris' || $^O eq 'aix') ? '+<:raw' : '<:raw'; sub lock() { my $self = shift; my $folder = $self->folder; ! $self->hasLock or $self->log(WARNING => "Folder $folder already flocked."), return 1; my $filename = $self->filename; open my $fh, $lockfile_access_mode, $filename or $self->log(ERROR => "Unable to open flock file $filename for $folder: $!"), return 0; my $timeout = $self->timeout; my $end = $timeout eq 'NOTIMEOUT' ? -1 : $timeout; while(1) { if($self->_try_lock($fh)) { $self->{MBLF_filehandle} = $fh; return $self->SUPER::lock; } $! == EAGAIN or $self->log(ERROR => "Will never get a flock on $filename for $folder: $!"), last; --$end or last; sleep 1; } return 0; } sub isLocked() { my $self = shift; my $filename = $self->filename; open my($fh), $lockfile_access_mode, $filename; unless($fh) { my $folder = $self->folder; $self->log(ERROR => "Unable to check lock file $filename for $folder: $!"); return 0; } $self->_try_lock($fh) or return 0; $self->_unlock($fh); $fh->close; $self->SUPER::unlock; 1; } sub unlock() { my $self = shift; $self->_unlock(delete $self->{MBLF_filehandle}) if $self->hasLock; $self->SUPER::unlock; $self; } 1; Mail-Box-3.012/lib/Mail/Box/Locker/Mutt.pm0000644000175000001440000000415515112047445020543 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::Locker::Mutt;{ our $VERSION = '3.012'; } use parent 'Mail::Box::Locker'; use strict; use warnings; use POSIX qw/sys_wait_h/; #-------------------- sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{MBLM_exe} = $args->{exe} || 'mutt_dotlock'; $self; } sub name() { 'MUTT' } sub lockfile() { $_[0]->filename . '.lock' } #-------------------- sub exe() { $_[0]->{MBLM_exe} } sub unlock() { my $self = shift; $self->hasLock or return $self; unless(system $self->exe, '-u', $self->filename) { my $folder = $self->folder; $self->log(WARNING => "Couldn't remove mutt-unlock $folder: $!"); } $self->SUPER::unlock; $self; } #-------------------- sub lock() { my $self = shift; my $folder = $self->folder; $self->hasLock and $self->log(WARNING => "Folder $folder already mutt-locked"), return 1; my $filename = $self->filename; my $lockfn = $self->lockfile; my $timeout = $self->timeout; my $end = $timeout eq 'NOTIMEOUT' ? -1 : $timeout; my $expire = $self->expires / 86400; # in days for -A my $exe = $self->exe; while(1) { system $exe, '-p', '-r', 1, $filename or return $self->SUPER::lock; WIFEXITED($?) && WEXITSTATUS($?)==3 or $self->log(ERROR => "Will never get a mutt-lock: $!"), return 0; if(-e $lockfn && -A $lockfn > $expire) { system $exe, '-f', '-u', $filename and $self->log(WARNING => "Removed expired mutt-lock $lockfn"), redo; $self->log(ERROR => "Failed to remove expired mutt-lock $lockfn: $!"); last; } --$end or last; sleep 1; } 0; } sub isLocked() { my $self = shift; system $self->exe, '-t', $self->filename; WIFEXITED($?) && WEXITSTATUS($?)==3; } 1; Mail-Box-3.012/lib/Mail/Box/Locker/FcntlLock.pm0000644000175000001440000000454015112047445021467 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::Locker::FcntlLock;{ our $VERSION = '3.012'; } use parent 'Mail::Box::Locker'; use strict; use warnings; use File::FcntlLock (); use Fcntl qw/F_WRLCK F_SETLK F_UNLCK/; use Errno qw/EAGAIN/; #-------------------- sub init($) { my ($self, $args) = @_; $args->{file} = $args->{posix_file} if $args->{posix_file}; $self->SUPER::init($args); } sub name() { 'FcntlLock' } #-------------------- sub _try_lock($) { my ($self, $file) = @_; my $fl = File::FcntlLock->new; $fl->l_type(F_WRLCK); $? = $fl->lock($file, F_SETLK); $?==0; } sub _unlock($) { my ($self, $file) = @_; my $fl = File::FcntlLock->new; $fl->l_type(F_UNLCK); $fl->lock($file, F_SETLK); $self; } sub lock() { my $self = shift; if($self->hasLock) { my $folder = $self->folder; $self->log(WARNING => "Folder $folder already lockf'd"); return 1; } my $file = $self->filename; open my $fh, '+<:raw', $file; unless(defined $fh) { my $folder = $self->folder; $self->log(ERROR => "Unable to open FcntlLock lock file $file for $folder: $!"); return 0; } my $timeout = $self->timeout; my $end = $timeout eq 'NOTIMEOUT' ? -1 : $timeout; while(1) { if($self->_try_lock($fh)) { $self->SUPER::lock; $self->{MBLF_filehandle} = $fh; return 1; } unless($!==EAGAIN) { my $folder = $self->folder; $self->log(ERROR => "Will never get a FcntlLock lock on $file for $folder: $!"); last; } --$end or last; sleep 1; } return 0; } sub isLocked() { my $self = shift; my $file = $self->filename; open my $fh, '<:raw', $file; unless($fh) { my $folder = $self->folder; $self->log(ERROR => "Unable to check lock file $file for $folder: $!"); return 0; } $self->_try_lock($fh)==0 or return 0; $self->_unlock($fh); $fh->close; $self->SUPER::unlock; 1; } sub unlock() { my $self = shift; $self->_unlock(delete $self->{MBLF_filehandle}) if $self->hasLock; $self->SUPER::unlock; $self; } 1; Mail-Box-3.012/lib/Mail/Box/Locker/DotLock.pod0000644000175000001440000001167515112047446021325 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::Locker::DotLock - lock a folder with a separate file =head1 INHERITANCE Mail::Box::Locker::DotLock is a Mail::Box::Locker is a Mail::Reporter =head1 SYNOPSIS See Mail::Box::Locker =head1 DESCRIPTION The C<::DotLock> object lock the folder by creating a file with the same name as the folder, extended by C<.lock>. Extends L<"DESCRIPTION" in Mail::Box::Locker|Mail::Box::Locker/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Locker|Mail::Box::Locker/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Locker|Mail::Box::Locker/"Constructors">. =over 4 =item $class-EB(%options) Name of the file to lock. By default, the folder's name is extended with C<.lock>. Improves base, see L -Option --Defined in --Default dotlock_file undef expires Mail::Box::Locker 1 hour file Mail::Box::Locker .lock folder Mail::Box::Locker > log Mail::Reporter 'WARNINGS' method Mail::Box::Locker 'DOTLOCK' timeout Mail::Box::Locker 10 trace Mail::Reporter 'WARNINGS' =over 2 =item dotlock_file => $file Alternative name for C, especially useful to confusion when the multi locker is used. =item expires => $seconds =item file => $file =item folder => $folder =item log => LEVEL =item method => $name|CLASS|\@names =item timeout => $seconds|'NOTIMEOUT' =item trace => LEVEL =back =back =head2 Attributes Extends L<"Attributes" in Mail::Box::Locker|Mail::Box::Locker/"Attributes">. =over 4 =item $obj-EB( [SECONDS] ) Inherited, see L =item $obj-EB( [$filename] ) Inherited, see L =item $obj-EB( [$folder] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [SECONDS] ) Inherited, see L =back =head2 Locking Extends L<"Locking" in Mail::Box::Locker|Mail::Box::Locker/"Locking">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Box::Locker|Mail::Box::Locker/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Box::Locker|Mail::Box::Locker/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Warning: Couldn't remove lockfile $lock: $! Cast by C =item Error: Failed to remove expired lockfile $lockfile: $! Cast by C =item Warning: Folder already locked with file $lockfile Cast by C =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Warning: Removed expired lockfile $lockfile Cast by C =back =head1 SEE ALSO This module is part of Mail-Box version 3.012, built on November 27, 2025. Website: F =head1 LICENSE 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. Mail-Box-3.012/lib/Mail/Box/Locker/NFS.pod0000644000175000001440000001247515112047446020413 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::Locker::NFS - lock a folder with a separate file, NFS-safe =head1 INHERITANCE Mail::Box::Locker::NFS is a Mail::Box::Locker is a Mail::Reporter =head1 SYNOPSIS See Mail::Box::Locker =head1 DESCRIPTION Like the C<::DotLock> locker, but then in an NFS-safe fashion. Over NFS, the creation of a file is not atomic. The C<::DotLock> locker depends on an atomic C system call, hence in not usable to lock a folder which accessed over NFS. The C<::NFS> locker is therefore more complicated (so therefore slower), but will work for NFS --and for local disks as well. Extends L<"DESCRIPTION" in Mail::Box::Locker|Mail::Box::Locker/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Locker|Mail::Box::Locker/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Locker|Mail::Box::Locker/"Constructors">. =over 4 =item $class-EB(%options) Inherited, see L -Option --Defined in --Default expires Mail::Box::Locker 1 hour file Mail::Box::Locker undef folder Mail::Box::Locker > log Mail::Reporter 'WARNINGS' method Mail::Box::Locker 'NFS' timeout Mail::Box::Locker 10 trace Mail::Reporter 'WARNINGS' =over 2 =item expires => $seconds =item file => $file =item folder => $folder =item log => LEVEL =item method => $name|CLASS|\@names =item timeout => $seconds|'NOTIMEOUT' =item trace => LEVEL =back =back =head2 Attributes Extends L<"Attributes" in Mail::Box::Locker|Mail::Box::Locker/"Attributes">. =over 4 =item $obj-EB( [SECONDS] ) Inherited, see L =item $obj-EB( [$filename] ) Inherited, see L =item $obj-EB( [$folder] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [SECONDS] ) Inherited, see L =back =head2 Locking Extends L<"Locking" in Mail::Box::Locker|Mail::Box::Locker/"Locking">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Box::Locker|Mail::Box::Locker/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Box::Locker|Mail::Box::Locker/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Warning: Folder $folder already locked over nfs Do not try to lock the folder when the application already has the lock: it will give you dead-locks. Cast by C =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Warning: Removed expired lockfile $file A lock C<$file> was found which was older than the expiration period as specified with L. The lock file was successfully removed. Cast by C =item Error: Unable to remove expired lockfile $file: $! A lock file was found which was older than the expiration period as specified with the L option. It is impossible to remove that lock file, so we need to wait until it vanishes by some external cause. Cast by C =back =head1 SEE ALSO This module is part of Mail-Box version 3.012, built on November 27, 2025. Website: F =head1 LICENSE 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. Mail-Box-3.012/lib/Mail/Box/Locker/Mutt.pod0000644000175000001440000001160615112047446020711 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::Locker::Mutt - lock a folder using mutt_dotlock =head1 INHERITANCE Mail::Box::Locker::Mutt is a Mail::Box::Locker is a Mail::Reporter =head1 SYNOPSIS See Mail::Box::Locker =head1 DESCRIPTION The C email reader includes a separate program which is specialized in locking folders. This locker class uses this external program. Mutt is not automatically installed. Extends L<"DESCRIPTION" in Mail::Box::Locker|Mail::Box::Locker/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Locker|Mail::Box::Locker/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Locker|Mail::Box::Locker/"Constructors">. =over 4 =item $class-EB(%options) Inherited, see L -Option --Defined in --Default exe mutt_dotlock expires Mail::Box::Locker 1 hour file Mail::Box::Locker undef folder Mail::Box::Locker > log Mail::Reporter 'WARNINGS' method Mail::Box::Locker 'DOTLOCK' timeout Mail::Box::Locker 10 trace Mail::Reporter 'WARNINGS' =over 2 =item exe => PATH The name of the program. May be a relative or absolute path. =item expires => $seconds =item file => $file =item folder => $folder =item log => LEVEL =item method => $name|CLASS|\@names =item timeout => $seconds|'NOTIMEOUT' =item trace => LEVEL =back =back =head2 Attributes Extends L<"Attributes" in Mail::Box::Locker|Mail::Box::Locker/"Attributes">. =over 4 =item $obj-EB() Returns the name of the external binary. =item $obj-EB( [SECONDS] ) Inherited, see L =item $obj-EB( [$filename] ) Inherited, see L =item $obj-EB( [$folder] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [SECONDS] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Locking Extends L<"Locking" in Mail::Box::Locker|Mail::Box::Locker/"Locking">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Box::Locker|Mail::Box::Locker/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Box::Locker|Mail::Box::Locker/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Warning: Couldn't remove mutt-unlock $folder: $! Cast by C =item Error: Failed to remove expired mutt-lock $lockfile: $! Cast by C =item Warning: Folder $folder already mutt-locked Cast by C =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =item Warning: Removed expired mutt-lock $lockfile Cast by C =back =head1 SEE ALSO This module is part of Mail-Box version 3.012, built on November 27, 2025. Website: F =head1 LICENSE 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. Mail-Box-3.012/lib/Mail/Box/Locker/NFS.pm0000644000175000001440000000566015112047445020242 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::Locker::NFS;{ our $VERSION = '3.012'; } use parent 'Mail::Box::Locker'; use strict; use warnings; use Sys::Hostname; use Carp; use Fcntl qw/O_CREAT O_WRONLY/; #-------------------- sub name() { 'NFS' } #-------------------- # METHOD nfs # This hack is copied from the Mail::Folder packages, as written # by Kevin Jones. Cited from his code: # Whhheeeee!!!!! # In NFS, the O_CREAT|O_EXCL isn't guaranteed to be atomic. # So we create a temp file that is probably unique in space # and time ($folder.lock.$time.$pid.$host). # Then we use link to create the real lock file. Since link # is atomic across nfs, this works. # It loses if it's on a filesystem that doesn't do long filenames. my $hostname = hostname; sub _tmpfilename() { my $self = shift; $self->{MBLN_tmp} ||= $self->filename . $$; } sub _construct_tmpfile() { my $self = shift; my $tmpfile = $self->_tmpfilename; sysopen my $fh, $tmpfile, O_CREAT|O_WRONLY, 0600 or return undef; $fh->close; $tmpfile; } sub _try_lock($$) { my ($self, $tmpfile, $lockfile) = @_; link $tmpfile, $lockfile or return undef; my $linkcount = (stat $tmpfile)[3]; unlink $tmpfile; $linkcount == 2; } sub _unlock($$) { my ($self, $tmpfile, $lockfile) = @_; unlink $lockfile or warn "Couldn't remove lockfile $lockfile: $!\n"; unlink $tmpfile; $self; } sub lock() { my $self = shift; my $folder = $self->folder; $self->hasLock and $self->log(WARNING => "Folder $folder already locked over nfs"), return 1; my $lockfile = $self->filename; my $tmpfile = $self->_construct_tmpfile or return; my $timeout = $self->timeout; my $end = $timeout eq 'NOTIMEOUT' ? -1 : $timeout; my $expires = $self->expires / 86400; # in days for -A if(-e $lockfile && -A $lockfile > $expires) { unlink $lockfile or $self->log(ERROR => "Unable to remove expired lockfile $lockfile: $!"), return 0; $self->log(WARNING => "Removed expired lockfile $lockfile."); } while(1) { return $self->SUPER::lock if $self->_try_lock($tmpfile, $lockfile); --$end or last; sleep 1; } return 0; } sub isLocked() { my $self = shift; my $tmpfile = $self->_construct_tmpfile or return 0; my $lockfile = $self->filename; my $fh = $self->_try_lock($tmpfile, $lockfile) or return 0; close $fh; $self->_unlock($tmpfile, $lockfile); $self->SUPER::unlock; 1; } sub unlock($) { my $self = shift; $self->hasLock or return $self; $self->_unlock($self->_tmpfilename, $self->filename); $self->SUPER::unlock; $self; } 1; Mail-Box-3.012/lib/Mail/Box/MH/0000755000175000001440000000000015112047462016333 5ustar00markovusers00000000000000Mail-Box-3.012/lib/Mail/Box/MH/Index.pm0000644000175000001440000000551615112047445017750 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::MH::Index;{ our $VERSION = '3.012'; } use parent 'Mail::Reporter'; use strict; use warnings; use Mail::Message::Head::Subset (); use Carp; #-------------------- sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{MBMI_filename} = $args->{filename} or croak "No index filename specified."; $self->{MBMI_head_wrap} = $args->{head_wrap} || 72; $self->{MBMI_head_type} = $args->{head_type} || 'Mail::Message::Head::Subset'; $self; } #-------------------- sub filename() { $_[0]->{MBMI_filename} } #-------------------- sub write(@) { my ($self, @messages) = @_; my $indexfn = $self->filename // return $self; # Remove empty index-file. unless(@messages) { unlink $indexfn; return $self; } open my $index, '>:raw', $indexfn or return $self; my $written = 0; foreach my $msg (@messages) { my $head = $msg->head; next if $head->isDelayed && $head->isa('Mail::Message::Head::Subset'); my $fn = $msg->filename; $index->print( "X-MailBox-Filename: $fn\n", 'X-MailBox-Size: ', (-s $fn), "\n", ); $head->print($index); $written++; } $index->close; $written or unlink $indexfn; $self; } sub append(@) { my ($self, @messages) = @_; my $indexfn = $self->filename or return $self; open my $index, '>>:raw', $indexfn or return $self; foreach my $msg (@messages) { my $head = $msg->head; next if $head->isDelayed && $head->isa('Mail::Message::Head::Subset'); my $fn = $msg->filename; $index->print( "X-MailBox-Filename: $fn\n", 'X-MailBox-Size: ', (-s $fn), "\n", ); $head->print($index); } $index->close; $self; } sub read(;$) { my $self = shift; my $filename = $self->filename; my $parser = Mail::Box::Parser->new(filename => $filename, mode => 'r') or return; my @options = ($self->logSettings, wrap_length => $self->{MBMI_head_wrap}); my $type = $self->{MBMI_head_type}; my $index_age = -M $filename; my %index; while(my $head = $type->new(@options)->read($parser)) { # cleanup the index from files which were renamed my $msgfile = $head->get('x-mailbox-filename'); my $size = int $head->get('x-mailbox-size'); next unless -f $msgfile && -s _ == $size; next if defined $index_age && -M _ < $index_age; # keep this one $index{$msgfile} = $head; } $parser->stop; $self->{MBMI_index} = \%index; $self; } sub get($) { my ($self, $msgfile) = @_; $self->{MBMI_index}{$msgfile}; } 1; Mail-Box-3.012/lib/Mail/Box/MH/Message.pm0000644000175000001440000000131315112047445020254 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::MH::Message;{ our $VERSION = '3.012'; } use parent 'Mail::Box::Dir::Message'; use strict; use warnings; use File::Copy; use Carp; #-------------------- # Purpose of above doc is only the warning... no new implementation required. #-------------------- 1; Mail-Box-3.012/lib/Mail/Box/MH/Index.pod0000644000175000001440000001271415112047446020115 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::MH::Index - keep index files for messages. =head1 INHERITANCE Mail::Box::MH::Index is a Mail::Reporter =head1 SYNOPSIS my $index = Mail::Box::MH::Index->new; $index->read(...) $index->write(...) =head1 DESCRIPTION Message folders which store their data in one single file per message are very inefficient for producing subject overviews and for computing message threads. The C object is able to store and read a the headers of a set of C messages which are part of a single C folder in one file. When the C functionality is enabled by specifying L when opening a folder, the index file is automatically read. When the folder is closed, a new index file is created. Special care is taken to avoid problems which occur when the user changes or removes message files without updating the index. If the index is not trustworthy it will not be used (costing some performance for the reader of the folder). Extends L<"DESCRIPTION" in Mail::Reporter|Mail::Reporter/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Reporter|Mail::Reporter/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Reporter|Mail::Reporter/"Constructors">. =over 4 =item $class-EB(%options) Inherited, see L -Option --Defined in --Default filename head_type Mail::Message::Head::Subset head_wrap 72 log Mail::Reporter 'WARNINGS' trace Mail::Reporter 'WARNINGS' =over 2 =item filename => $file The C<$file> which is used to store the headers of all the e-mails for one folder. This must be an absolute pathname. =item head_type => $class The type of headers which will be used to store header information when it is read from the index file. You can not be sure the index contains all header line (the mailbox may have been updated without updating the index) so this will usually be (an sub-class of) L. =item head_wrap => $nrchars The preferred maximum number of characters in each header line. =item log => LEVEL =item trace => LEVEL =back =back =head2 Attributes Extends L<"Attributes" in Mail::Reporter|Mail::Reporter/"Attributes">. =over 4 =item $obj-EB() Returns the name of the index file. =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Reporter|Mail::Reporter/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Reporter|Mail::Reporter/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head2 The Index =over 4 =item $obj-EB(@messages) Append C<@messages> to the index file. =item $obj-EB($msgfile) Look if there is header info for the specified C<$msgfile>. The filename represents one message in folder type which are organized as directory. This method will return an object of the L as specified during creation of the index object, or C if the information is not known or not trustworthy -i.e. the file size changed. =item $obj-EB() Read the index file. The header objects can after this be requested with the L method. =item $obj-EB(@messages) Write an index file containing the headers specified C<@messages> (L objects). =back =head1 DIAGNOSTICS =over 4 =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =back =head1 SEE ALSO This module is part of Mail-Box version 3.012, built on November 27, 2025. Website: F =head1 LICENSE 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. Mail-Box-3.012/lib/Mail/Box/MH/Labels.pm0000644000175000001440000000541115112047445020075 0ustar00markovusers00000000000000# This code is part of Perl distribution Mail-Box version 3.012. # 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::MH::Labels;{ our $VERSION = '3.012'; } use parent 'Mail::Reporter'; use strict; use warnings; use Mail::Message::Head::Subset; use File::Copy; use Carp; #-------------------- #-------------------- sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{MBML_filename} = $args->{filename} or croak "No label filename specified."; $self; } #-------------------- sub filename() { $_[0]->{MBML_filename} } #-------------------- sub get($) { my ($self, $msgnr) = @_; $self->{MBML_labels}[$msgnr]; } sub read() { my $self = shift; my $seqfn = $self->filename; open my $seq, '<:raw', $seqfn or return; my @labels; local $_; while(<$seq>) { s/\s*\#.*$//; length or next; s/^\s*(\w+)\s*\:\s*// or next; my $label = $1; my $set = 1; if($label eq 'cur' ) { $label = 'current' } elsif($label eq 'unseen') { $label = 'seen'; $set = 0 } foreach (split /\s+/) { if( /^(\d+)\-(\d+)\s*$/ ) { push @{$labels[$_]}, $label, $set foreach $1..$2; } elsif( /^\d+\s*$/ ) { push @{$labels[$_]}, $label, $set; } } } $seq->close; $self->{MBML_labels} = \@labels; $self; } sub write(@) { my $self = shift; my $filename = $self->filename; # Remove when no messages are left. unless(@_) { unlink $filename; return $self; } open my $out, '>:raw', $filename or return; $self->print($out, @_); close $out; $self; } sub append(@) { my $self = shift; my $filename = $self->filename; open my $out, '>>:raw', $filename or return; $self->print($out, @_); close $out; $self; } sub print($@) { my ($self, $out) = (shift, shift); # Collect the labels from the selected messages. my %labeled; foreach my $message (@_) { my $labels = $message->labels; my $seq = $message->filename =~ s!.*/!!r; push @{$labeled{unseen}}, $seq unless $labels->{seen}; foreach (keys %$labels) { push @{$labeled{$_}}, $seq if $labels->{$_}; } } delete $labeled{seen}; # Write it out local $" = ' '; foreach (sort keys %labeled) { my @msgs = @{$labeled{$_}}; #they are ordered already. $_ = 'cur' if $_ eq 'current'; print $out "$_:"; while(@msgs) { my $start = shift @msgs; my $end = $start; $end = shift @msgs while @msgs && $msgs[0]==$end+1; print $out ($start==$end ? " $start" : " $start-$end"); } print $out "\n"; } $self; } 1; Mail-Box-3.012/lib/Mail/Box/MH/Labels.pod0000644000175000001440000001051015112047446020240 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::MH::Labels - maintain MH message related labels =head1 INHERITANCE Mail::Box::MH::Labels is a Mail::Reporter =head1 SYNOPSIS my $labels = Mail::Box::MH::Labels->new; $labels->read(...) $labels->write(...) =head1 DESCRIPTION MH type message folders use one dedicated file per folder-directory to list special tags to messages in that folder. By doing this, mail agents may avoid parsing all the messages, which is very resource consuming. Labels can be used to group messages, for instance to reflect which messages have been read or which look like spam. Some labels are predefined, but more can be added without limitation. Extends L<"DESCRIPTION" in Mail::Reporter|Mail::Reporter/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Reporter|Mail::Reporter/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Reporter|Mail::Reporter/"Constructors">. =over 4 =item $class-EB(%options) Inherited, see L -Option --Defined in --Default filename log Mail::Reporter 'WARNINGS' trace Mail::Reporter 'WARNINGS' =over 2 =item filename => FILENAME The FILENAME which is used in each directory to store the headers of all mails. The filename must be an absolute path. =item log => LEVEL =item trace => LEVEL =back =back =head2 Attributes Extends L<"Attributes" in Mail::Reporter|Mail::Reporter/"Attributes">. =over 4 =item $obj-EB() Returns the name of the index file. =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Reporter|Mail::Reporter/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $any-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $any-EB( [$level, [$strings]] ) Inherited, see L =item $any-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Reporter|Mail::Reporter/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head2 The Label Table =over 4 =item $obj-EB($messages) Append the label information about the specified C<$messages> to the end of the label file. The information will not be merged with the information already present in the label file. =item $obj-EB($msgnr) Look if there is label info for message C<$msgnr>. =item $obj-EB($fh, $messages) Print the labels of the specified messages to the opened file. =item $obj-EB() Read all label information from file. =item $obj-EB(@messages) Write the labels related to the specified C<@messages> to the label file. =back =head1 DIAGNOSTICS =over 4 =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. Cast by C =back =head1 SEE ALSO This module is part of Mail-Box version 3.012, built on November 27, 2025. Website: F =head1 LICENSE 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. Mail-Box-3.012/lib/Mail/Box/MH/Message.pod0000644000175000001440000004330015112047446020425 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::MH::Message - one message in an MH-folder =head1 INHERITANCE Mail::Box::MH::Message is a Mail::Box::Dir::Message is a Mail::Box::Message is a Mail::Message is a Mail::Reporter =head1 SYNOPSIS my $folder = new Mail::Box::MH ... my $message = $folder->message(10); =head1 DESCRIPTION A C represents one message in an L folder . Each message is stored in a separate file, as for all L folder types. Extends L<"DESCRIPTION" in Mail::Box::Dir::Message|Mail::Box::Dir::Message/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Dir::Message|Mail::Box::Dir::Message/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Dir::Message|Mail::Box::Dir::Message/"Constructors">. =over 4 =item $obj-EB(%options) Inherited, see L =item $class-EB(%options) Inherited, see L =back =head2 Attributes Extends L<"Attributes" in Mail::Box::Dir::Message|Mail::Box::Dir::Message/"Attributes">. =over 4 =item $obj-EB( [$filename] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$folder] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$integer] ) The order of this message in the folder, counted from zero. Do not change the number (unless you understand the implications). WARNING: This sequence number has nothing to do with the message's filename, which in case of MH folders are also numbers! If you need that one, use the File::Basename subroutine basename of the filename. Improves base, see L =back =head2 Constructing a message Extends L<"Constructing a message" in Mail::Box::Dir::Message|Mail::Box::Dir::Message/"Constructing a message">. =over 4 =item $obj-EB( [<$rg_object|%options>] ) Inherited, see L =item $class-EB( [$message|$part|$body], @fields, %options ) Inherited, see L =item $class-EB($body, [$head], $headers) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $class-EB($fh|STRING|SCALAR|ARRAY, %options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB( [STRING|$field|$address|ARRAY-$of-$things] ) Inherited, see L =item $any-EB(STRING) Inherited, see L =back =head2 The message Extends L<"The message" in Mail::Box::Dir::Message|Mail::Box::Dir::Message/"The message">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($folder, %options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB($folder, %options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB( [$mailer], %options ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =back =head2 The header Extends L<"The header" in Mail::Box::Dir::Message|Mail::Box::Dir::Message/"The header">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB($fieldname) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$head] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB($fieldname) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 The body Extends L<"The body" in Mail::Box::Dir::Message|Mail::Box::Dir::Message/"The body">. =over 4 =item $obj-EB( [$body] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [<'ALL'|'ACTIVE'|'DELETED'|'RECURSE'|$filter>] ) Inherited, see L =back =head2 Flags Extends L<"Flags" in Mail::Box::Dir::Message|Mail::Box::Dir::Message/"Flags">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( [BOOLEAN] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB