File Coverage

blib/lib/Metabrik/Shell/Rc.pm
Criterion Covered Total %
statement 9 55 16.3
branch 0 22 0.0
condition 0 17 0.0
subroutine 3 9 33.3
pod 2 6 33.3
total 14 109 12.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # shell::rc Brik
5             #
6             package Metabrik::Shell::Rc;
7 1     1   732 use strict;
  1         2  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         47  
9              
10 1     1   6 use base qw(Metabrik);
  1         2  
  1         819  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(custom) ],
16             attributes => {
17             input => [ qw(file) ],
18             create_default => [ qw(0|1) ],
19             },
20             attributes_default => {
21             create_default => 1,
22             },
23             commands => {
24             load => [ qw(input|OPTIONAL) ],
25             execute => [ qw($line_list) ],
26             write_default => [ ],
27             load_and_execute => [ qw(input|OPTIONAL) ],
28             },
29             };
30             }
31              
32             sub brik_use_properties {
33 0     0 1   my $self = shift;
34              
35             return {
36             attributes_default => {
37             input => defined($self->global) && $self->global->homedir.'/.metabrik_rc'
38 0   0       || defined($ENV{HOME}) && $ENV{HOME}.'/.metabrik_rc' || '/tmp/.metabrik_rc',
39             },
40             };
41             }
42              
43             sub load {
44 0     0 0   my $self = shift;
45 0           my ($input) = @_;
46              
47 0   0       $input ||= $self->input;
48              
49 0 0 0       if (! -f $input && $self->create_default) {
50 0           $self->write_default;
51             }
52              
53 0 0 0       if (! -f $input && ! $self->create_default) {
54 0           return $self->log->error("load: can't find rc file [$input]");
55             }
56              
57 0           my @lines = ();
58 0 0         open(my $in, '<', $input)
59             or return $self->log->error("local: can't open rc file [$input]: $!");
60 0           while (defined(my $line = <$in>)) {
61 0           chomp($line);
62 0 0         next if $line =~ /^\s*$/; # Skip blank lines
63 0 0         next if $line =~ /^\s*#/; # Skip comments
64 0           $line =~ s/^(.*)#.*$/$1/; # Strip comments at end of line
65 0           push @lines, "$line "; # Add a trailing slash in case of a multiline
66             # So when joining them, there is no unwanted concatenation
67             }
68 0           close($in);
69              
70 0           $self->log->debug("load: success");
71              
72 0           return \@lines;
73             }
74              
75             sub execute {
76 0     0 0   my $self = shift;
77 0           my ($lines) = @_;
78              
79 0 0         if (! defined($self->shell)) {
80 0           return $self->log->error("execute: no core::shell Brik");
81             }
82              
83 0 0         $self->brik_help_run_undef_arg('execute', $lines) or return;
84 0 0         $self->brik_help_run_invalid_arg('execute', $lines, 'ARRAY') or return;
85              
86 0           my $shell = $self->shell;
87              
88 0           $shell->cmdloop($lines);
89              
90 0           return 1;
91             }
92              
93             sub write_default {
94 0     0 0   my $self = shift;
95 0           my ($file) = @_;
96              
97 0   0       $file ||= $self->input;
98              
99 0 0         if (-f $file) {
100 0           return $self->log->error("write_default: file [$file] already exists");
101             }
102              
103 0 0         open(my $out, '>', $file)
104             or return $self->log->error("write_default: open: file [$file]: $!");
105              
106 0           my $content = <
107             set core::shell echo 0
108              
109             my \$home = \$ENV{HOME}
110             my \$user = \$ENV{USER}
111              
112             set core::global ctimeout 5
113             set core::global rtimeout 5
114             set core::shell ps1 Meta
115             set core::log level 1
116              
117             use shell::command
118             use shell::history
119             use brik::tool
120             use brik::search
121              
122             alias reuse "run core::context reuse"
123             alias pwd "run core::shell pwd"
124             alias update_available "run core::context update_available"
125             alias reuse "run core::context reuse"
126             alias system "run shell::command system"
127             alias capture "run shell::command capture"
128             alias ls "run shell::command capture ls -Fh"
129             alias l "run shell::command capture ls -lFh"
130             alias ll "run shell::command capture ls -lFh"
131             alias cp "run shell::command capture cp -rfp"
132             alias rm "run shell::command capture rm -rf"
133             alias find "run shell::command capture find"
134             alias grep "run shell::command capture grep"
135             alias ! "run shell::history exec"
136             alias history "run shell::history show"
137             alias source "run shell::rc load_and_execute"
138             alias search "run brik::search"
139             alias show "run brik::search all"
140              
141             run shell::history load
142              
143             set core::shell echo 1
144             EOF
145              
146 0           print $out $content;
147              
148 0           close($out);
149              
150 0           $self->log->verbose("write_default: default rc file [$file] created");
151              
152 0           return 1;
153             }
154              
155             sub load_and_execute {
156 0     0 0   my $self = shift;
157 0           my ($input) = @_;
158              
159 0   0       $input ||= $self->input;
160              
161 0 0         my $lines = $self->load($input) or return;
162 0           return $self->execute($lines);
163             }
164              
165             1;
166              
167             __END__