App-MonM-Notifier
view release on metacpan or search on metacpan
lib/App/MonM/Notifier/Store.pm view on Meta::CPAN
package App::MonM::Notifier::Store; # $Id: Store.pm 81 2022-09-16 10:21:57Z abalama $
use strict;
use utf8;
=encoding utf8
=head1 NAME
App::MonM::Notifier::Store - monotifier store class
=head1 VERSION
Version 1.02
=head1 SYNOPSIS
use App::MonM::Notifier::Store;
my $store = App::MonM::Notifier::Store->new(
dsn => "DBI:mysql:database=monotifier;host=mysql.example.com",
user => "username",
password => "password",
set => [
"RaiseError 0",
"PrintError 0",
"mysql_enable_utf8 1",
],
expires => 3600*24*7,
maxtime => 300,
);
die($store->error) if $store->error;
=head1 DESCRIPTION
DBI interface for monotifier store. This module provides store methods
=head2 new
my $store = App::MonM::Notifier::Store->new(
dsn => "DBI:mysql:database=monotifier;host=mysql.example.com",
user => "username",
password => "password",
set => [
"RaiseError 0",
"PrintError 0",
"mysql_enable_utf8 1",
],
expires => 3600*24*7,
maxtime => 300,
);
Creates DBI object
=over 8
=item B<expires>
Time in seconds of life of database record
=item B<maxtime>
Max time in seconds to sending one message
=back
=head2 cleanup
my $st = $store->cleanup;
Removes permanently queue entities based on how old they are
=head2 dequeue
my $st = $store->dequeue(
id => 1,
);
Dequeues the element by setting success status (STATUS_SENT)
=head2 delById
$store->delById($id) or die($store->error);
Delete record by id
=head2 dsn
my $dsn = $store->dsn;
Returns DSN string of current database connection
=head2 enqueue
$store->enqueue(
to => $user,
channel => $ch_name,
subject => $subject,
message => $message,
attributes => $ch, # Channel attributes
) or die($store->error);
Adds a new element at the end of the current queue
and returns queue element ID
=head2 error
my $error = $store->error;
lib/App/MonM/Notifier/Store.pm view on Meta::CPAN
`id` INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL UNIQUE,
`to` CHAR(255), -- Recipient name
`channel` CHAR(255), -- Recipient channel
`subject` TEXT, -- Message subject
`message` TEXT, -- Message content (BASE64)
`attributes` TEXT, -- Message attributes (JSON)
`published` BIGINT(20), -- The publication time (unixtime)
`scheduled` BIGINT(20), -- The scheduled time (unixtime)
`expired` BIGINT(20), -- The expiration time (unixtime)
`sent` BIGINT(20), -- The send time
`attempt` INTEGER DEFAULT 0, -- Count of failed attempts
`status` CHAR(32), -- Status of transaction
`errcode` INT(11), -- Error code
`errmsg` TEXT -- Error message
)
=head1 ERRORCODES
0 -- No errors found
1 -- Error of the notifier level (notify method)
2 -- Error of the notifier level (remind method)
255 -- Error of the cleanup level
=head1 SEE ALSO
L<CTK::DBI>, L<App::MonM>
=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.02';
use File::Spec;
use MIME::Base64 qw/encode_base64 decode_base64/;
use CTK::DBI;
use CTK::Util qw/ read_attributes touch /;
use CTK::ConfGenUtil;
use CTK::TFVals qw/ :ALL /;
use CTK::Serializer;
use App::MonM::Const;
use App::MonM::Util qw/ set2attr /;
use constant {
EXPIRES => 30*24*60*60, # 30 days max (how time to hold of messages)
MAXTIME => 300, # 5 min
JSON_ATTRS => [
{ # For serialize
utf8 => 0,
pretty => 1,
allow_nonref => 1,
allow_blessed => 1,
},
{ # For deserialize
utf8 => 0,
allow_nonref => 1,
allow_blessed => 1,
},
],
# Database
DB_FILENAME_NASK => 'monotifier-%s.db', # username
DEFAULT_DSN_MASK => 'dbi:SQLite:dbname=%s',
DEFAULT_DBI_ATTR => {
dsn => '', # See DEFAULT_DSN_MASK
user => '',
password => '',
set => [
'RaiseError 0',
'PrintError 0',
'sqlite_unicode 1',
],
},
# Statuses
STATUS_NEW => 'NEW',
STATUS_BUSY => 'BUSY',
STATUS_FAIL => 'FAIL', # See Attempt
STATUS_SENT => 'SENT',
};
use constant MONOTIFIER_DDL => <<'DDL';
CREATE TABLE IF NOT EXISTS monotifier (
`id` INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL UNIQUE,
`to` CHAR(255), -- Recipient name
`channel` CHAR(255), -- Recipient channel
`subject` TEXT, -- Message subject
`message` TEXT, -- Message content (BASE64)
`attributes` TEXT, -- Message attributes (JSON)
`published` BIGINT(20), -- The publication time (unixtime)
`scheduled` BIGINT(20), -- The scheduled time (unixtime)
`expired` BIGINT(20), -- The expiration time (unixtime)
`sent` BIGINT(20), -- The send time
`attempt` INTEGER DEFAULT 0, -- Count of failed attempts
`status` CHAR(32), -- Status of transaction
`errcode` INT(11), -- Error code
`errmsg` TEXT -- Error message
)
DDL
use constant MONOTIFIER_ADD => <<'DML';
INSERT INTO monotifier
(`to`,`channel`,`subject`,`message`,`attributes`,`published`,`scheduled`,`expired`,`sent`,`attempt`,`status`,`errcode`,`errmsg`)
VALUES
(?,?,?,?,?,?,?,?,?,?,?,?,?)
lib/App/MonM/Notifier/Store.pm view on Meta::CPAN
undef, # errmsg
$id || 0
);
if ($dbi->connect->err) {
$self->error(sprintf("Can't change status: %s", uv2null($dbi->connect->errstr)));
return;
}
return $id;
}
sub cleanup { # Delete too old records by expired field
my $self = shift;
return 0 unless $self->ping;
$self->error("");
my $dbi = $self->{dbi};
# CleanUp (by expired)
my $now = time();
$dbi->execute(MONOTIFIER_CLEANUP, $now);
if ($dbi->connect->err) {
$self->error(sprintf("Can't delete records (cleanup): %s", uv2null($dbi->connect->errstr)));
return 0;
}
# CleanUp (by maxtime)
my $maxtime = $self->{maxtime} || MAXTIME;
$dbi->execute(MONOTIFIER_FLUSH,
STATUS_FAIL, # status
255, # errcode (Cleanup level)
"Sending the message is taking too long!", # errmsg
STATUS_BUSY, STATUS_NEW,
$now - $maxtime,
);
if ($dbi->connect->err) {
$self->error(sprintf("Can't update records (cleanup): %s", uv2null($dbi->connect->errstr)));
return 0;
}
return 1;
}
sub purge {
my $self = shift;
return 0 unless $self->ping;
$self->error("");
my $dbi = $self->{dbi};
$dbi->execute(MONOTIFIER_PURGE);
if ($dbi->connect->err) {
$self->error(sprintf("Can't purge table: %s", uv2null($dbi->connect->errstr)));
return 0;
}
return 1;
}
sub _sheduled_calc {
my $t = shift; # Attempt number
if ($t >= 0 and $t < 5) { return 60 } # 1 min per 5 min (5 times)
elsif ($t >= 5 and $t < 7) { return 60*5 } # 5 min per 15 min (2 times)
elsif ($t >= 7 and $t < 10) { return 60*15 } # 15 min per 1 hour (3 times)
elsif ($t >= 10 and $t < 33) { return 60*60 } # 1 hour per day (23 times)
elsif ($t >= 33 and $t < 39) { return 60*60*24 } # 1 day per week (6 times)
elsif ($t >= 39 and $t < 42) { return 60*60*24*7 } # 1 week per month (3 times)
return 60*60*24*30; # every 1 month
}
1;
__END__
( run in 2.881 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )