view release on metacpan or  search on metacpan

lib/App/Nag.pm  view on Meta::CPAN

use Modern::Perl;
use Getopt::Long::Descriptive qw(describe_options prog_name);

# some icon specs
use constant PHRASE    => [qw(psst hey HEY !!!)];
use constant STROKE    => [qw(0000ff 0000ff ff0000 ff0000)];
use constant FILL      => [qw(ffffff ffffff ffffff ffff00)];
use constant OPACITY   => [ 0, 1, 1, 1 ];
use constant FONT_SIZE => [ 20, 25, 28, 32 ];
use constant XY        => [ [ 8, 40 ], [ 9, 40 ], [ 7, 41 ], [ 3, 43 ] ];


sub validate_args {
    my $name = prog_name;
    my ( $opt, $usage ) = describe_options(
        "$name %o <time> <text>+",
        [],
        ['Send yourself a reminder.'],
        [],
        [
            'urgency' => hidden => {
                one_of => [
                    [ 'nudge|n', 'low key reminder' ],
                    [
                        'poke|p',
                        'reminder with no particular urgency (default)'
                    ],
                    [ 'shake|s', 'urgent reminder' ],
                    [ 'slap',    'do this!!!' ],
                ]
            }
        ],
        [],
        [ 'help', "print usage message and exit" ],
    );

    print( $usage->text ), exit if $opt->help;
    given ( scalar @ARGV ) {
        when (0) {
            $usage->die(
                {
                    pre_text => "ERROR: No time or message.\n\n"
                }
              )
        }
        when (1) {
            $usage->die(
                {
                    pre_text => "ERROR: No message.\n\n"
                }
              )
        }
    }
    return ( $opt, $usage, $name );
}


sub validate_time {
    my ( undef, $opt, $usage, $time, @args ) = @_;
    require DateTime;
    require DateTime::TimeZone;

    # parse time
    $usage->die(
        {
            pre_text => "ERROR: could not understand time expression: $time\n\n"
        }
    ) unless my %props = _parse_time($time);
    my $tz = DateTime::TimeZone->new( name => 'local' );
    my $now = DateTime->now( time_zone => $tz );
    my $then = $now->clone;

    if ( $props{unit} ) {
        my $unit = $props{unit};
        given ($unit) {
            when ('h') { $unit = 'hours' }
            when ('m') { $unit = 'minutes' }
            when ('s') { $unit = 'seconds' }
        }
        $then->add( $unit => $props{time} );
    }
    else {
        my ( $hour, $minute ) = @props{qw(hour minute)};
        $usage->die( { pre_text => "ERROR: impossible time\n\n" } )
          unless $hour < 25 && $minute < 60;
        my $suffix = $props{suffix};
        $usage->die( { pre_text => "ERROR: impossible time\n\n" } )
          if $hour > 12 && $suffix eq 'a';
        $then->set( hour => $hour, minute => $minute, second => 0 );
        if ( $hour < 13 ) {
            $then->add( hours => 12 ) while $then < $now;
            given ($suffix) {
                when ('a') { $then->add( hours => 12 ) if $then->hour >= 12 }
                when ('p') { $then->add( hours => 12 ) if $then->hour < 12 }
            }
        }
        else {
            $then->add( days => 1 ) if $then < $now;
        }
    }
    my $seconds = $then->epoch - $now->epoch;
    $seconds = 0 if $seconds < 0;    # same moment

    # set verbosity level
    my $verbosity;
    given ( $opt->urgency ) {
        when ('nudge') { $verbosity = 0 }
        when ('poke')  { $verbosity = 1 }
        when ('shake') { $verbosity = 2 }
        when ('slap')  { $verbosity = 3 }
        default        { $verbosity = 1 }
    };

    # generate message text and synopsis
    my $text = join ' ', @args;
    $text =~ s/^\s++|\s++$//g;
    $text =~ s/\s++/ /g;
    ( my $synopsis = $text ) =~ s/^(\S++(?: \S++){0,3}).*/$1/;
    $synopsis .= ' ...' if length($text) - length($synopsis) > 4;
    return ( $verbosity, $text, $synopsis, $seconds );
}

# extract useful bits out of a time expression
# tried to do this with a more readable recursive regex and callbacks but got
# OOM errors at unpredictable intervals so I gave up
sub _parse_time {
    my %props;
    given ( $_[0] ) {
        when (/^(\d++)([hms])$/i) { @props{qw(time unit)} = ( $1, lc $2 ) }
        when (/^(\d{1,2})(?::(\d{2}))?(?:([ap])(\.?)m\4)?$/i) {