File Coverage

blib/lib/App/iTan/Command/List.pm
Criterion Covered Total %
statement 17 32 53.1
branch 0 4 0.0
condition n/a
subroutine 6 8 75.0
pod 0 2 0.0
total 23 46 50.0


line stmt bran cond sub pod time code
1             # ================================================================
2             package App::iTan::Command::List;
3             # ================================================================
4 1     1   1013 use utf8;
  1         3  
  1         7  
5 1     1   32 use Moose;
  1         1  
  1         8  
6 1     1   5293 use 5.0100;
  1         3  
7              
8 1     1   4 use MooseX::App::Command;
  1         2  
  1         10  
9             with qw(App::iTan::Utils);
10              
11 1     1   6655 use Text::Table;
  1         1  
  1         24  
12 1     1   5 use Moose::Util::TypeConstraints qw(enum);
  1         1  
  1         8  
13              
14             our @SORTFIELDS = qw(tindex imported used);
15              
16             option 'sort' => (
17             is => 'ro',
18             isa => enum(\@SORTFIELDS),
19             required => 1,
20             default => $SORTFIELDS[0],
21             documentation => q[Set list sorting (].(join ',',@SORTFIELDS).q[)],
22             );
23              
24             sub execute {
25 0     0 0   my ( $self, $opts, $args ) = @_;
26            
27 0           my $tb = $self->get_table();
28            
29 0           print $tb->title;
30 0           print $tb->rule('-','+');
31 0           print $tb->body;
32            
33 0           return;
34             }
35              
36             sub get_table {
37 0     0 0   my ($self) = @_;
38            
39 0           my $sort = $self->sort;
40 0 0         $sort .= ','.$SORTFIELDS[0]
41             unless $SORTFIELDS[0] eq $sort;
42 0 0         my $sth = $self->dbh->prepare("SELECT tindex,imported,used,memo
43             FROM itan
44             WHERE valid = 1 OR used IS NOT NULL
45             ORDER BY $sort")
46             or die "ERROR: Cannot prepare: " . $self->dbh->errstr();
47 0           $sth->execute();
48            
49 0           my $tb = Text::Table->new(
50             "Index",\"|","Imported",\"|","Used",\"|","Memo"
51             );
52            
53 0           while (my @line = $sth->fetchrow_array) {
54 0           $tb->add(@line);
55             }
56            
57 0           return $tb;
58             }
59              
60             __PACKAGE__->meta->make_immutable;
61             1;
62              
63             =pod
64              
65             =encoding utf8
66              
67             =head1 NAME
68              
69             App::iTan::Command::List - List of all iTANs
70              
71             =head1 SYNOPSIS
72              
73             itan list [--sort (tindex imported used)]
74              
75             =head1 DESCRIPTION
76              
77             List of all either used or still available iTANs.
78              
79             =head1 OPTIONS
80              
81             =head2 sort
82              
83             Set list sorting. Available options are
84              
85             =over
86              
87             =item * tindex
88              
89             =item * imported
90              
91             =item * used
92              
93             =back
94              
95             =cut