view release on metacpan or  search on metacpan

Mail/Folder/Mbox.pm  view on Meta::CPAN

=head2 append_message($mref)

=over 2

Calls the superclass C<append_message> method.

Creates a new mail message file, in the temporary working directory,
with the contents of the mail message contained in C<$mref>.
It will synthesize a 'From ' line if one is not present in
C<$mref>.

If the 'Content-Length' option is not set, then C<get_message> will
escape 'From ' lines in the body of the message.

=cut

sub append_message {
  my $self = shift;
  my $mref = shift;
  
  my $msgnum = $self->last_message;
  
  my $dup_mref = $mref->dup;

  return 0 unless $self->SUPER::append_message($dup_mref);

  my $dup_href = $mref->head->dup;
  $dup_mref->escape_from unless ($self->get_option('Content-Length'));
  
  $msgnum++;
  my $fh = new IO::File("$self->{MBOX_WorkingDir}/$msgnum",
			O_CREAT|O_WRONLY, 0600)
    or croak "can't create $self->{MBOX_WorkingDir}/$msgnum: $!";
  _coerce_header($dup_href);
  $dup_href->print($fh);
  $fh->print("\n");
  $dup_mref->print_body($fh);
  $fh->close;

  $self->remember_message($msgnum);
  
  return 1;
}

=head2 update_message($msg_number, $mref)

Calls the superclass C<update_message> method.

Replaces the message pointed to by C<$msg_number> with the contents of
the C<Mail::Internet> object reference C<$mref>.

It will synthesize a 'From ' line if one is not present in
$mref.

If the 'Content-Length' option is not set, then C<get_message> will
escape 'From ' lines in the body of the message.

=cut

sub update_message {
  my $self = shift;
  my $key = shift;
  my $mref = shift;
  
  my $file_pos = 0;
  my $filename = "$self->{MBOX_WorkingDir}/$key";
  
  my $dup_mref = $mref->dup;
  my $dup_href = $dup_mref->head->dup;

  return 0 unless $self->SUPER::update_message($key, $dup_mref);

  $dup_mref->escape_from unless $self->get_option('Content-Length');

  my $fh = new IO::File "$filename.new", O_CREAT|O_WRONLY, 0600
    or croak "can't create $filename.new: $!";
  _coerce_header($dup_href);
  $dup_href->print($fh);
  $fh->print("\n");
  $dup_mref->print_body($fh);
  $fh->close;

  rename("$filename.new", $filename) or
    croak "can't rename $filename.new to $filename: $!";
  
  return 1;
}

=head2 init

Initializes various items specific to B<Mbox>.

=over 2

=item * Determines an appropriate temporary directory.  If the
C<TMPDIR> environment variable is set, it uses that, otherwise it uses
C</tmp>.  The working directory will be a subdirectory in that
directory.

=item * Bumps a sequence number used for unique temporary filenames.

=item * Initializes C<$self-E<gt>{WorkingDir}> to the name of a
directory that will be used to hold the working copies of the messages
in the folder.

=back

=cut

sub init {
  my $self = shift;

  my $tmpdir = $ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp";

  $self->{MBOX_WorkingDir} = undef;
  $folder_id++;
  for my $i ($folder_id .. ($folder_id + 10)) {
    if (! -e "$tmpdir/mbox$folder_id.$$") {
      $self->{MBOX_WorkingDir} = "$tmpdir/mbox.$folder_id.$$";
      last;