File Coverage

blib/lib/Metabrik/Shell/History.pm
Criterion Covered Total %
statement 9 94 9.5
branch 0 42 0.0
condition 0 2 0.0
subroutine 3 12 25.0
pod 2 9 22.2
total 14 159 8.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # shell::history Brik
5             #
6             package Metabrik::Shell::History;
7 1     1   1056 use strict;
  1         3  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         29  
9              
10 1     1   6 use base qw(Metabrik);
  1         2  
  1         1346  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(command) ],
16             attributes => {
17             history_file => [ qw(file) ],
18             },
19             commands => {
20             load => [ ],
21             write => [ ],
22             get => [ ],
23             get_one => [ qw(integer) ],
24             get_range => [ qw(integer_first..integer_last) ],
25             show => [ ],
26             execute => [ qw(integer|integer_first..integer_last) ],
27             },
28             };
29             }
30              
31             sub brik_use_properties {
32 0     0 1   my $self = shift;
33              
34             return {
35             attributes_default => {
36             history_file => defined($self->global) && $self->global->homedir.'/.metabrik_history'
37 0   0       || defined($ENV{HOME}) && $ENV{HOME}.'/.metabrik_history'
38             || '/tmp/.metabrik_history',
39             },
40             };
41             }
42              
43             sub load {
44 0     0 0   my $self = shift;
45              
46 0 0         if (! defined($self->shell)) {
47 0           return $self->log->error("load: no core::shell Brik");
48             }
49              
50 0           my $shell = $self->shell;
51 0           my $history_file = $self->history_file;
52              
53 0 0         if ($shell->term->can('ReadHistory')) {
54 0 0         if (! -f $history_file) {
55 0           return $self->log->error("load: can't find history file [$history_file]");
56             }
57              
58 0 0         $shell->term->ReadHistory($history_file)
59             or return $self->log->error("load: can't ReadHistory file [$history_file]: $!");
60              
61 0           $self->log->debug("load: success");
62             }
63             else {
64 0           $self->log->warning("load: cannot ReadHistory");
65             }
66              
67 0           return 1;
68             }
69              
70             sub write {
71 0     0 0   my $self = shift;
72              
73 0 0         if (! defined($self->shell)) {
74 0           return $self->log->error("write: no core::shell Brik");
75             }
76              
77 0           my $shell = $self->shell;
78 0           my $history_file = $self->history_file;
79              
80 0 0         if ($shell->term->can('WriteHistory')) {
81 0 0         $shell->term->WriteHistory($history_file)
82             or return $self->log->error("load: can't WriteHistory file [$history_file]: $!");
83 0           $self->log->debug("write: success");
84             }
85             else {
86 0           $self->log->warning("load: cannot WriteHistory");
87             }
88              
89 0           return 1;
90             }
91              
92             sub get {
93 0     0 0   my $self = shift;
94              
95 0 0         if (! defined($self->shell)) {
96 0           return $self->log->error("get: no core::shell Brik");
97             }
98              
99 0           my $shell = $self->shell;
100              
101 0           my @history = ();
102 0 0         if ($shell->term->can('GetHistory')) {
103 0           @history = $shell->term->GetHistory;
104              
105 0           $self->log->debug("get: success");
106             }
107             else {
108 0           $self->log->warning("load: cannot GetHistory");
109             }
110              
111 0           return \@history;
112             }
113              
114             sub get_one {
115 0     0 0   my $self = shift;
116 0           my ($number) = @_;
117              
118 0 0         if (! defined($self->shell)) {
119 0           return $self->log->error("get_one: no core::shell Brik");
120             }
121              
122 0 0         $self->brik_help_run_undef_arg('get_one', $number) or return;
123 0 0         if ($number !~ /^\d+$/) {
124 0           return $self->log->error($self->brik_help_run('get_one'));
125             }
126              
127 0           my $shell = $self->shell;
128              
129 0           my $history = '';
130 0           my @history = ();
131 0 0         if ($shell->term->can('GetHistory')) {
132 0           @history = $shell->term->GetHistory;
133 0           $history = $history[$number];
134              
135 0           $self->log->debug("get_one: success");
136             }
137             else {
138 0           $self->log->warning("load: cannot GetHistory");
139             }
140              
141 0           return $history;
142             }
143              
144             sub get_range {
145 0     0 0   my $self = shift;
146 0           my ($range) = @_;
147              
148 0 0         if (! defined($self->shell)) {
149 0           return $self->log->error("get_range: no core::shell Brik");
150             }
151              
152 0 0         $self->brik_help_run_undef_arg('get_range', $range) or return;
153 0 0         if ($range !~ /^\d+\.\.\d+$/) {
154 0           return $self->log->error($self->brik_help_run('get_range'));
155             }
156              
157 0           my $shell = $self->shell;
158              
159 0           my @history = ();
160 0 0         if ($shell->term->can('GetHistory')) {
161 0           @history = $shell->term->GetHistory;
162 0           @history = @history[eval($range)];
163              
164 0           $self->log->debug("get_range: success");
165             }
166             else {
167 0           $self->log->warning("load: cannot GetHistory");
168             }
169              
170 0           return \@history;
171             }
172              
173             sub show {
174 0     0 0   my $self = shift;
175              
176 0           my $history = $self->get;
177              
178 0           my $count = 0;
179 0           for (@$history) {
180 0           print "$_ # ! $count\n";
181 0           $count++;
182             }
183              
184 0           return $count - 1;
185             }
186              
187             sub execute {
188 0     0 0   my $self = shift;
189 0           my ($numbers) = @_;
190              
191 0 0         if (! defined($self->shell)) {
192 0           return $self->log->error("execute: no core::shell Brik");
193             }
194              
195 0 0         $self->brik_help_run_undef_arg('execute', $numbers) or return;
196              
197             # We want to execute some history command(s)
198 0           my $lines = [];
199 0 0         if ($numbers =~ /^\d+$/) {
    0          
200 0           $lines = [ $self->get_one($numbers) ];
201             }
202             elsif ($numbers =~ /^\d+\.\.\d+$/) {
203 0           $lines = $self->get_range($numbers);
204             }
205              
206 0           my $shell = $self->shell;
207              
208 0           $shell->cmdloop($lines);
209              
210 0           return 1;
211             }
212              
213             1;
214              
215             __END__