File Coverage

blib/lib/TestML1/Library/Standard.pm
Criterion Covered Total %
statement 51 58 87.9
branch 6 8 75.0
condition n/a
subroutine 17 19 89.4
pod 0 17 0.0
total 74 102 72.5


line stmt bran cond sub pod time code
1             package TestML1::Library::Standard;
2              
3 24     24   867 use TestML1::Base;
  24         54  
  24         113  
4             extends 'TestML1::Library';
5              
6 24     24   1330 use TestML1::Util;
  24         65  
  24         18872  
7              
8             sub Get {
9 1     1 0 3 my ($self, $key) = @_;
10 1         5 return $self->runtime->function->getvar($key->str->value);
11             }
12              
13             # sub Set {
14             # my ($self, $key, $value) = @_;
15             # return $self->runtime->function->setvar($key, $value);
16             # }
17              
18             sub GetLabel {
19 3     3 0 4 my ($self) = @_;
20 3         8 return str($self->runtime->get_label);
21             }
22              
23             sub Type {
24 13     13 0 25 my ($self, $var) = @_;
25 13         35 return str($var->type);
26             }
27              
28             sub Catch {
29 7     7 0 11 my ($self) = @_;
30 7 50       18 my $error = $self->runtime->error
31             or die "Catch called but no TestML1 error found";
32 7         34 $error =~ s/ at .* line \d+\.\n\z//;
33 7         15 $self->runtime->{error} = undef;
34 7         20 return str($error);
35             }
36              
37             sub Throw {
38 7     7 0 24 my ($self, $msg) = @_;
39 7         23 die $msg->value;
40             }
41              
42             sub Str {
43 2     2 0 5 my ($self, $object) = @_;
44 2         6 return str($object->str->value);
45             }
46             # sub Num {
47             # my ($self, $object) = @_;
48             # return num($object->num->value);
49             # }
50             # sub Bool {
51             # my ($self, $object) = @_;
52             # return bool($object->bool->value);
53             # }
54             sub List {
55 8     8 0 15 my $self = shift;
56 8         20 return list([@_]);
57             }
58              
59             sub Join {
60 10     10 0 18 my ($self, $list, $separator) = @_;
61 10 100       23 $separator = $separator ? $separator->value : '';
62 10         12 my @strings = map $_->value, @{$list->list->value};
  10         21  
63 10         33 return str join $separator, @strings;
64             }
65              
66             sub Not {
67 9     9 0 16 my ($self, $bool) = @_;
68 9 100       27 return bool($bool->bool->value ? 0: 1);
69             }
70              
71             sub Text {
72 16     16 0 24 my ($self, $lines) = @_;
73 16         25 my $value = $lines->list->value;
74 16         34 return str(join $/, map($_->value, @$value), '');
75             }
76              
77             sub Count {
78 2     2 0 4 my ($self, $list) = @_;
79 2         3 return num scalar @{$list->list->value};
  2         7  
80             }
81              
82             sub Lines {
83 22     22 0 34 my ($self, $text) = @_;
84 22         38 return list([ map str($_), split /\n/, $text->value ]);
85             }
86              
87             sub Reverse {
88 4     4 0 8 my ($self, $list) = @_;
89 4         9 my $value = $list->list->value;
90 4         12 return list([ reverse @$value ]);
91             }
92              
93             sub Sort {
94 8     8 0 12 my ($self, $list) = @_;
95 8         15 my $value = $list->list->value;
96 8         25 return list([ sort { $a->value cmp $b->value } @$value ]);
  20         30  
97             }
98              
99             sub Strip {
100 9     9 0 12 my ($self, $string, $part) = @_;
101 9         17 $string = $string->str->value;
102 9         18 $part = $part->str->value;
103 9 50       23 if ((my $i = index($string, $part)) >= 0) {
104 9         20 $string = substr($string, 0, $i) . substr($string, $i + length($part));
105             }
106 9         17 return str $string;
107             }
108              
109             sub Print {
110 0     0 0   my ($self, $string) = @_;
111 0           print STDOUT $string->value;
112 0           return bool(1);
113             }
114              
115             sub Chomp {
116 0     0 0   my ($self, $string) = @_;
117 0           my $value = $string->str->value;
118 0           chomp($value);
119 0           return str $value;
120             }
121              
122             1;
123              
124             # sub Has {
125             # my ($self, $string, $part) = @_;
126             # $string = $string->str->value;
127             # $part = $part->str->value;
128             # return bool(index($string, $part) >= 0);
129             # }
130              
131             # sub RunCommand {
132             # require Capture::Tiny;
133             # my ($self, $command) = @_;
134             # $command = $command->value;
135             # chomp($command);
136             # my $sub = sub {
137             # system($command);
138             # };
139             # my ($stdout, $stderr) = Capture::Tiny::capture($sub);
140             # $self->runtime->function->setvar('_Stdout', $stdout);
141             # $self->runtime->function->setvar('_Stderr', $stderr);
142             # return str('');
143             # }
144              
145             # sub RmPath {
146             # require File::Path;
147             # my ($self, $path) = @_;
148             # $path = $path->value;
149             # File::Path::rmtree($path);
150             # return str('');
151             # }
152              
153             # sub Stdout {
154             # my ($self) = @_;
155             # return $self->runtime->function->getvar('_Stdout');
156             # }
157              
158             # sub Stderr {
159             # my ($self) = @_;
160             # return $self->runtime->function->getvar('_Stderr');
161             # }
162              
163             # sub Chdir {
164             # my ($self, $dir) = @_;
165             # $dir = $dir->value;
166             # chdir $dir;
167             # return str('');
168             # }
169              
170             # sub Read {
171             # my ($self, $file) = @_;
172             # $file = $file->value;
173             # use Cwd;
174             # open FILE, $file or die "Can't open $file for input in " . Cwd::cwd;
175             # my $text = do { local $/; };
176             # close FILE;
177             # return str($text);
178             # }
179              
180             # sub Pass {
181             # my ($self, @args) = @_;
182             # return @args;
183             # }
184              
185             # sub Raw {
186             # my $self = shift;
187             # my $point = $self->point
188             # or die "Raw called but there is no point";
189             # return $self->runtime->block->points->{$point};
190             # }
191              
192             # sub Point {
193             # my ($self, $name) = @_;
194             # $name = $name->value;
195             # $self->runtime->get_point($name);
196             # }