App-Basis-Queue
view release on metacpan or search on metacpan
use App::Basis::Queue ;
use Date::Manip::Date ;
use feature 'say' ;
use Lingua::EN::Inflexion ;
# what about Data::Dumper::GUI or YAML::Tiny::Color
# use Data::Printer ;
# -----------------------------------------------------------------------------
use constant QUEUE_CONFIG => "$ENV{HOME}/.abq" ;
use constant FIVE_DAYS => 5 * 24 * 3600 ;
use constant PEEK_DEFAULT => 10 ;
use constant EXEC_DEFAULT => 1 ;
# -----------------------------------------------------------------------------
# lets do the testing stuff with private variables
{
my $testing = 0 ;
sub set_testing
{
$testing = 1 ;
}
sub is_testing
{
$testing ;
}
}
# -----------------------------------------------------------------------------
my $program = get_program() ;
# -----------------------------------------------------------------------------
# always create the datetime strings the same way
sub std_datetime
{
my ($secs) = @_ ;
$secs ||= time() ;
return strftime( "%Y-%m-%d %H:%M:%S UTC", gmtime($secs) ) ;
}
# -----------------------------------------------------------------------------
# convert something like a datetime string or an epoch value into a standardised
# datetime string and epoch value
sub parse_datetime
{
my ($datetime) = @_ ;
state $date = Date::Manip::Date->new() ;
my @ret ;
if ( !$datetime ) {
return wantarray ? ( undef, undef ) : undef ;
} elsif ( $datetime =~ /^\d+$/ ) {
# assume anything less than five days is a time into the future
$datetime += time() if ( $datetime <= FIVE_DAYS ) ;
@ret = ( std_datetime($datetime), $datetime ) ;
} else {
# so parse will parse in locale time not as UTC
$date->parse($datetime) ;
{
# if we get a warning about converting the date to a day, there
# must be a problem with parsing the input date string
local $SIG{__WARN__} = sub {
die "Invalid date, could not parse" ;
} ;
my $day = $date->printf("%a") ;
}
my $d2 = $date->printf("%O %Z") ;
# reparse the date to get it into UTC, best way I could think of :(
$date->parse($d2) ;
# secs_since_1970_GMT is epoch
@ret = (
std_datetime( $date->secs_since_1970_GMT() ),
$date->secs_since_1970_GMT()
) ;
}
return wantarray ? @ret : $ret[0] ;
}
# -----------------------------------------------------------------------------
# connect to the queue DB
sub connect_queue
{
my ( $dsn, $user, $passwd, $qname ) = @_ ;
my $dbh
= DBI->connect( $dsn, $user, $passwd,
{ RaiseError => 1, PrintError => 0, AutoCommit => 1 } )
or die "Could not connect to DB $dsn" ;
if ( $dsn =~ /SQLite/i ) {
$dbh->do("PRAGMA journal_mode = WAL") ;
$dbh->do("PRAGMA synchronous = NORMAL") ;
}
my $queue = App::Basis::Queue->new(
dbh => $dbh,
default_queue => $qname,
debug => 0,
) ;
return $queue ;
}
# -----------------------------------------------------------------------------
# main
my $action ;
my %opt = init_app(
help_text => "Simple script to queue messages for later action
use perldoc $program to get the setup for the " . QUEUE_CONFIG . " config file
if message is '-' input read from STDIN",
help_cmdline => "message to send",
options => {
'verbose|v' => 'Output useful information',
( run in 0.944 second using v1.01-cache-2.11-cpan-ceb78f64989 )