view release on metacpan or  search on metacpan

bin/qtask  view on Meta::CPAN

    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',
        'queue|q=s' => { desc => 'queue to add things to', required => 1 },
        'size|s'    => 'Disply the number of unprocessed items in a task queue',
        'peek|p=i' => { desc =>
            'Display the next few items in a task queue',
            },
        'exec|e=s' => {
            desc =>
                "command to run with the message, use count to limit, default "
                . EXEC_DEFAULT,
        },
        'activates|a=s' => {
            desc =>
                'Parsable UTC datetime after which the message should be valid',
        },
        'count|c=i' => 'Number of messages to read',
    }
) ;

my $msg = join( ' ', @ARGV ) ;
verbose( "first up msg is $msg") ;
if ( $opt{test} ) {
    set_verbose(1) ;
    set_testing(1) ;
}

show_usage( "No config file found", 1) if( ! -f QUEUE_CONFIG) ;

# lets have the config named after this program
my $cfg = App::Basis::Config->new(
    filename     => QUEUE_CONFIG,
    die_on_error => 1
) ;

my $q = $cfg->get("queue") ;
msg_exit( "Could not find valid config in " . QUEUE_CONFIG, 2 )
    if ( !$q ) ;

my ( $activates, $epoch ) = parse_datetime( $opt{activates} ) ;