view release on metacpan or  search on metacpan

lib/App/MonM/Channel/File.pm  view on Meta::CPAN

=head1 HISTORY

See C<Changes> file

=head1 DEPENDENCIES

L<Compress::Raw::Zlib>

=head1 TO DO

See C<TODO> file

=head1 SEE ALSO

L<Compress::Raw::Zlib>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2022 D&D Corporation. All Rights Reserved

=head1 LICENSE

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See C<LICENSE> file and L<https://dev.perl.org/licenses/>

=cut

use vars qw/$VERSION/;
$VERSION = '1.00';

use File::Spec;

use CTK::ConfGenUtil;
use CTK::Util qw/ dformat date_time2dig date2dig /;
use App::MonM::Util qw/ set2attr /;

use constant {
    FILEEXT     => "msg",
    FILEMASK    => "[DATETIME]-[ID].[EXT]",
};

sub sendmsg {
    my $self = shift;
    return $self->maybe::next::method() unless $self->type eq 'file';
    my $message = $self->message;

    # Options
    my $options = set2attr($self->chconf) || {};
    #print App::MonM::Util::explain($options);

    # File
    my $filemask = value($self->chconf, "filemask") || value($self->chconf, "file") || FILEMASK;
    my $filename = dformat($filemask, {
            ID      => $self->message->msgid,
            TO      => $self->message->to,
            RCPT    => $self->message->recipient, RECIPIENT => $self->message->recipient,
            EXT     => FILEEXT,
            TIME    => time(), DATETIME=> date_time2dig(), DATE    => date2dig(),
        });
    my $dir = value($self->chconf, "directory") || value($self->chconf, "dir") || File::Spec->tmpdir;
    my $file;
    if (File::Spec->file_name_is_absolute($filename)) {
        $file = $filename;
    } else {
        unless (-e $dir and -w $dir) {
            $self->error(sprintf("Can't use directory: %s", $dir));
            return 0;
        }
        $file = File::Spec->catfile($dir, $filename);
    }

    # Save
    $message->save($file) or do {
        $self->error($message->error);
        return 0;
    };

    #printf "Send message %s to %s (%s) via %s\n", $self->message->msgid, $self->message->to, $self->message->recipient,  $self->type;

    return 1;
}

1;

__END__