view release on metacpan or  search on metacpan

lib/Mail/Audit.pm  view on Meta::CPAN

  $self->_log(2, "   From: " . ($self->get("from")));
  $self->_log(2, "     To: " . ($self->get("to")));
  $self->_log(2, "Subject: " . ($self->get("subject")));

  # do we have a MIME-Version header?
  # if so,  we subclass MIME::Entity.
  # if not, we remain   Mail::Internet, and, presumably, diminish, and go
  # into the West.
  if ($opts{alwaysmime} or $mime_test->($self)) {
    unless ($opts{nomime}) {
      $self->_log(3,
        "message is MIME.  MIME-Version is " . ($self->get("MIME-Version"))
      );
      eval {
        require Mail::Audit::MimeEntity;
        Mail::Audit::MimeEntity->import;
      };
      die "$@" if $@;
      $self = Mail::Audit::MimeEntity->_autotype_new($self, $opts{mimeoptions});
    } else {
      $self->_log(3, "message is MIME, but 'nomime' option was set.");
    }
  }

  ($self->{_hostname} = Sys::Hostname::hostname) =~ s/\..*//;

  $self->{_audit_opts} = \%opts;
  $self->{_audit_opts}->{noexit}               ||= 0;
  $self->{_audit_opts}->{interpolate_strftime} ||= 0;
  $self->{_audit_opts}->{one_for_all}          ||= 0;

  return $self;
}

sub _emergency_mbox {
  my ($self) = @_;

  return $self->{_audit_opts}->{emergency}
    if exists $self->{_audit_opts}->{emergency};

  return $self->{_audit_opts}->{emergency} = $self->_default_mbox;
}

sub _default_mbox {
  my ($self) = @_;
  return $self->{_default_mbox} if exists $self->{_default_mbox};

  # XXX: How very unixocentric of us; how can we fix this? -- rjbs, 2006-06-04
  #      It's not really broken, but it's also not very awesome.
  my $default_mbox = $ENV{MAIL};

  return $default_mbox if $default_mbox;

  my $default_maildir = File::Spec->catdir(
    File::HomeDir->my_home,
    'Maildir'
  );

  $default_mbox =
       (-d File::Spec->catdir($default_maildir, 'new') ? $default_maildir : ())
    || ((grep { -d $_ } qw(/var/spool/mail/ /var/mail/))[0] . getpwuid($>));

  return $self->{_default_mbox} = $default_mbox;
}

# XXX: This is a test case until I have a better interface.  This will make
# testing simpler! -- rjbs, 2006-06-04
sub _exit {
  my ($self, $exit) = @_;

  return $self->{_audit_opts}->{_exit}->(@_)
    if exists $self->{_audit_opts}->{_exit};

  exit $exit;
}


sub _shorthand_expand {
  # perform ~user and %Y%m%d strftime expansion
  my $self       = shift;
  my $local_opts = $self->_get_opt(\@_);
  my @out        = @_;

  my $opt = 'interpolate_strftime';
  if (
    ((exists $local_opts->{$opt} and $local_opts->{$opt})
      or $self->{_audit_opts}->{$opt})
    and grep { index($_, '%') >= 0 } @out
  ) {
    my @localtime  = localtime;
    require POSIX;
    import POSIX qw(strftime);
    @out = map { strftime($_, @localtime) } @out;
  }

  return @out = map { $self->_expand_homedir($_) } @out;
}

sub _expand_homedir {
  my ($self, $path) = @_;

  my ($user, $rest) = $path =~ m!^~(\w*)((?:[/\\]).+)?$!;

  return $path unless defined $user and defined $rest;
  my $base = (length $user) ? File::HomeDir->users_home($user)
                            : File::HomeDir->my_home;

  return "$base$rest";
}

sub accept {
  my $self = shift;

  my $local_opts = $self->_get_opt(\@_);

  return $self->{_audit_opts}->{accept}->(@_, $local_opts)
    if exists $self->{_audit_opts}->{accept};

  my @files = $self->_shorthand_expand(@_, $local_opts);

  @files = $self->_default_mbox unless @files;