App-MonM
view release on metacpan or search on metacpan
lib/App/MonM/Store.pm view on Meta::CPAN
DML
use constant CHECKIT_UPDATE => <<'DML';
UPDATE monm SET
`time` = ?, `name` = ?, `type` = ?, `source` = ?, `status` = ?, `message` = ?
WHERE `id` = ?
DML
use constant CHECKIT_DELETE => <<'DML';
DELETE FROM monm WHERE `id` = ?
DML
use constant CHECKIT_CLEAN => <<'DML';
DELETE FROM monm WHERE `time` < ?
DML
use constant CHECKIT_SELECT => <<'DML';
SELECT `id`, `time`, `name`, `type`, `source`, `status`, `message`
FROM monm
WHERE `name` = ?
DML
use constant CHECKIT_SELECT_ALL => <<'DML';
SELECT `id`, `time`, `name`, `type`, `source`, `status`, `message`
FROM monm
DML
sub new {
my $class = shift;
my %args = @_;
unless ($args{dsn}) {
my $dda = DEFAULT_DBI_ATTR;
foreach (%$dda) {
$args{$_} //= $dda->{$_}
}
}
my $file = $args{file} || DB_FILENAME;
my $dsn = $args{dsn} || sprintf(DEFAULT_DSN_MASK, $file);
# DB
my $db = CTK::DBI->new(
-dsn => $dsn,
-debug => 0,
-username => $args{'user'},
-password => $args{'password'},
-attr => set2attr($args{'set'}),
$args{timeout} ? (
-timeout_connect => $args{timeout},
-timeout_request => $args{timeout},
) : (),
);
my $dbh = $db->connect if $db;
# SQLite
my $fnew = 0;
my $issqlite = 0;
if ($dbh && $dsn =~ /SQLite/i) {
$file = $dbh->sqlite_db_filename();
unless ($file && (-e $file) && !(-z $file)) {
touch($file);
chmod(0666, $file);
$fnew = 1;
}
$issqlite = 1;
}
# Errors
my $error = "";
if (!$db) {
$error = sprintf("Can't init database \"%s\"", $dsn);
} elsif (!$dbh) {
$error = sprintf("Can't connect to database \"%s\": %s", $dsn, $DBI::errstr || "unknown error");
} elsif ($fnew) {
$db->execute(CHECKIT_DDL);
$error = $dbh->errstr() if $dbh->err;
}
unless ($error) {
$error = sprintf("Can't init database \"%s\". Ping failed: %s",
$dsn, $dbh->errstr() || "unknown error") unless $dbh->ping;
}
my $self = bless {
file => $file,
issqlite=> $issqlite,
dsn => $dsn,
error => $error // "",
dbi => $db,
}, $class;
return $self;
}
sub error {
my $self = shift;
my $err = shift;
return $self->{error} unless defined $err;
$self->{error} = $err;
return $self->{error};
}
sub ping {
my $self = shift;
return 0 unless $self->{dsn};
my $dbi = $self->{dbi};
return 0 unless $dbi;
my $dbh = $dbi->{dbh};
return 0 unless $dbh;
return 0 unless $dbh->can('ping');
return $dbh->ping();
}
sub dsn {
my $self = shift;
return $self->{dsn};
}
sub is_sqlite {
my $self = shift;
return $self->{issqlite} ? 1 : 0;
}
# CRUD Methods
sub add {
my $self = shift;
( run in 0.750 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )