view release on metacpan or  search on metacpan

lib/Mail/POP3/Folder/mbox.pm  view on Meta::CPAN

    if (!-s $self->_spoolfile) {
        # no mail
        return;
    }
    my $seen_message_end = 1; # the end of fake "message 0"...
    my $messagecnt = 0;
    my $messageoctets = 0;
    my $messageuidl = '';
    local *MDROP;
    open MDROP, $self->_spoolfile;
    while (<MDROP>) {
        $self->_lock_update;
        s/\r|\n//g;
        if ($seen_message_end and /$self->{MESSAGE_START}/) {
            # tick over
            $self->_close_old_message(
                $messagecnt,
                $messageuidl,
                $messageoctets,
            );
            $messagecnt++;
            $messageuidl = '';
            $messageoctets = 0;
            $self->_start_new_message($messagecnt, $_);
        } else {
            $seen_message_end = 0;
            if (/$self->{MESSAGE_END}/) {
                $seen_message_end = 1;
            }
            if (/^Message-Id:\s*(.+)/ and not $messageuidl) {
                # only take first Message-ID; cf such a header appearing in body
                $messageuidl = $1;
            }
            $self->_push_message($messagecnt, $_);
            $messageoctets += length ($_.$CRLF);
        }
    }
    # catch the last one
    $self->_close_old_message($messagecnt, $messageuidl, $messageoctets);
    $self->{MESSAGECNT} = $messagecnt;
}

sub _spoolfile {
    my $self = shift;
    $self->{SPOOLFILE};
}

sub lock_acquire {
    my $self = shift;
    my $lockfile = $self->_lock_filename;
    return if -f $lockfile;
    $self->{LINE} = 0;
    $self->{LOCK_FH} = IO::File->new(
        ">$lockfile"
    ) or die "open >$lockfile: $!\n";
    unless (flock $self->{LOCK_FH}, LOCK_EX|LOCK_NB) {
        unlink $lockfile;
        return;
    }
    chmod 0600, $lockfile;
    chown $self->{CLIENT_USER_ID}, $self->{MAILGROUP}, $lockfile;
    my $oldfh = select $self->{LOCK_FH};
    $| = 1;
    select $oldfh;
    $self->_lock_refresh;
    # stat the file to get its size, this is checked before closing
    # the mailbox.
    # If the size has changed the lock may have been compromised, so a
    # backup is then made.
    my @filestat = stat $self->_spoolfile;
    $self->{MAILBOX_TIMESTAMP_OPEN} = $filestat[9];
    # set effective UID to user for the rest of the session;
    $> = $self->{CLIENT_USER_ID};
    $self->_list_messages;
die unless $self->{LOCK_FH};
    1;
}

sub lock_release {
    my $self = shift;
    close $self->{LOCK_FH};
    $> = 0;
    unlink $self->_lock_filename;
    $> = $self->{CLIENT_USER_ID};
}

sub _lock_filename {
    my ($self) = @_;
    "$self->{SPOOLFILE}.lock";
}

sub _lock_refresh {
    # This is to update the m time on the <user>.lock mbox lock file.
    # It may seem paranoid but I have seen lock files removed by impatient
    # MDA's, so the file is written-to, unbuffered, as often as is
    # practicable.
    my $self = shift;
    $> = 0;
die unless $self->{LOCK_FH};
    seek $self->{LOCK_FH}, 0, SEEK_SET;
    $self->{LOCK_FH}->print("\0");
    $> = $self->{CLIENT_USER_ID};
}

sub _lock_update {
    my $self = shift;
    if (++$self->{LINE} == 1000) {
        $self->_lock_refresh;
        $self->{LINE} = 0;
    }
}

sub _push_message_line {
    my ($self, $messagecnt, $data) = @_;
    push @{ $self->{MSG2TEXT}->{$messagecnt} }, "$data$CRLF";
}

sub _set_message_line {
    my ($self, $messagecnt, $lineno, $data) = @_;
    $self->{MSG2TEXT}->{$messagecnt}->[$lineno] = $data;
}