view release on metacpan or  search on metacpan

lib/App/MonM/Message.pm  view on Meta::CPAN

    # Add X-Recipient
    $self->{recipient} = $recipient;
    $email->header_str_set("X-Recipient" => $recipient);

    # Done
    $self->email($email);

    return $self;
}

sub email {
    my $self = shift;
    my $v = shift;
    $self->{email} = $v if defined $v;
    return $self->{email};
}
sub error {
    my $self = shift;
    my $v = shift;
    $self->{error} = $v if defined $v;
    return $self->{error};
}
sub msgid {
    my $self = shift;
    return $self->{msgid};
}
sub genId {
    my $self = shift;
    my @arr = @_;
    unshift @arr, $$;
    my $text = join("|", @arr);
    my $t = time;
    my $short = $t & 0x7FFFFF;
    my $fnv = $self->{fnv32a}->digest($text) & 0xFFFFFFFF;
    my $salt = join '', map {; $CHARS[rand @CHARS] } (0..6);
    my $u = exists $UNIQCNT{$t} ? ++$UNIQCNT{$t} : (%UNIQCNT = ($t => 0))[1];
    # hex(SHORT_TIME) . hex(TIME_UNIQ_CNT) . SALT . hex(FNV32a)
    return sprintf("%x%x%s%x",$short, $u, $salt, $fnv);
}
sub save {
    my $self = shift;
    my $file = shift;
    $self->error("");
    unless ($file) {
        $self->error("No file specified");
        return;
    }
    my $email = $self->email;
    unless ($email) {
        $self->error("No email object found");
        return;
    }

    my $fh = IO::File->new($file, "w");
    unless (defined $fh) {
        $self->error("Can't write file $file: $!");
        return;
    }

    $fh->binmode(); # ':raw:utf8'
    $fh->print($email->as_string);
    undef $fh;
    return 1;
}
sub load {
    my $self = shift;
    my $file = shift;
    $self->error("");
    unless ($file) {
        $self->error("No file specified");
        return;
    }
    unless (-e $file) {
        $self->error("No file found: $file");
        return;
    }
    my $size = -s $file;
    unless ($size) {
        $self->error("The file is empty: $file");
        return;
    }

    # Load file
    my $fh = IO::File->new($file, "r");
    unless (defined $fh) {
        $self->error("Can't load file $file: $!");
        return;
    }

    $fh->binmode(':raw:utf8');
    my $buf;
    read $fh, $buf, $size; # File::Slurp in a nutshell
    undef $fh;

    # Set email object
    my $email = Email::MIME->new($buf);
    $self->email($email);
    my $to = $email->header("To");

    # Add X-Recipient
    my $recipient = $email->header("X-Recipient") || $to || USERNAME;
    $self->{recipient} = $recipient;

    # Add X-Message-ID
    my $msgid = $email->header("X-Message-ID");
    unless ($msgid) {
        my $subject = $email->header("Subject");
        $msgid = $self->genId($to, $subject);
        $email->header_str_set("X-Message-ID" => $msgid);
    }
    $self->{msgid} = $msgid;

    return $self;
}
sub recipient {
    my $self = shift;
    return $self->{recipient};
}
sub to {
    my $self = shift;
    my $val = $self->email->header("To");
    return $val;
}
sub from {
    my $self = shift;
    my $val = $self->email->header("From");
    return $val;
}
sub subject {
    my $self = shift;
    my $val = $self->email->header("Subject");
    return $val;
}
sub body {
    my $self = shift;
    my $val = $self->email->body;
    return $val;
}

1;

__END__