view release on metacpan or  search on metacpan

bin/todo.pl  view on Meta::CPAN

    }
}

=head2 result_ok RESULT, MESSAGE[, ERROR]

Make sure that a result returned by C<call> indicates success. If so,
print MESSAGE.  If MESSAGE is a subroutine reference, execute it to get
the message. Otherwise, die with a YAML dump of the result.  If the optional
ERROR message is supplied, it will be printed after the YAML dump (so it is
prominently visible to the user).

=cut

sub result_ok {
    my $result = shift;
    my $message = shift;
    my $error   = shift;

    if(!$result->{failure}) {
        print ref($message) ? $message->() . "\n" : "$message\n";
    } elsif ($result->{message} =~ /^Access Denied/) {
        warn("Session expired, attempting to re-authenticate\n");
        delete $config{sid};
        save_config();
        do_login() or die("Bad username/password -- edit $CONFFILE and try again.");
        $commands{$command}->();
    } else {
        my $death = Dump($result);
        $death .= "\n$error\n" if defined $error;
        die $death;
    }
}

=head2 PRIORITY

Conversions between text priorities ('A' - 'Z'), and the 1-5 integer
scale Hiveminder uses internally.

=cut

sub priority_to_string {
    my $pri = shift;
    return chr(ord('A') + 5 - $pri);
}

sub priority_from_string {
    my $pri = lc shift;
    return 5 + ord('a') - ord($pri) if $pri =~ /^[a-e]$/;
    my %primap = (
        lowest  => 1,
        low     => 2,
        normal  => 3,
        high    => 4,
        highest => 5
       );
    return $primap{$pri} || $pri;
}

sub priority_to_color {
    my $pri = priority_from_string(shift);
    my @colormap = ('blue', 'blue', 'green', 'red', 'red bold');
    return $colormap[$pri - 1];
}

=head2 args_to_task

Convert argument passed on the command-line into a hash appropriate
for passing as arguments to BTDT actions.

=cut

sub args_to_task {
    my %task;

    $task{tags} = join_tags(@{$args{tag}}) if $args{tag};
    $task{group_id} = $args{group} if $args{group};
    $task{priority} = $args{priority} if $args{priority};
    $task{due} = $args{due} if $args{due};
    $task{starts} = $args{hide} if $args{hide};
    
    return \%task;
}

sub join_tags {
    my @tags = @_;
    return join(" ", map {'"' . $_ . '"'} @tags);
}

sub overdue {
    my ($year, $month, $day) = split '-', shift, 3;
    my @now = localtime;
    
    if    ( $year  <  $now[5]+1900 ) { return 1 }   # Past year
    elsif ( $year  >  $now[5]+1900 ) { return 0 }   # Future year
    elsif ( $month <  $now[4]+1 )    { return 1 }   # Equal year, past month
    elsif ( $month >  $now[4]+1 )    { return 0 }   # Equal year, future month
    elsif ( $day   <= $now[3] )      { return 1 }   # Equal year-month, past day or today
    else                             { return 0 }   # Equal year-month, future day
}

=head2 supports_color

Tests if the terminal supports color and returns true if so, false otherwise.
If there is no controlling TTY, then color will be disabled.

=end comment

=cut

sub supports_color {
    # We're not on a TTY, kill color
    return 0 if not -t *STDOUT;

    if ( $Config{'osname'} eq 'MSWin32' ) {
        eval { require Win32::Console::ANSI; };
        return 1 if not $@;
    }
    else {
        return 1 if $ENV{'TERM'} =~ /^(xterm|rxvt|linux|ansi|screen)/;
        return 1 if $ENV{'COLORTERM'};
    }