File Coverage

blib/lib/App/Chart/Sympred.pm
Criterion Covered Total %
statement 18 20 90.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 25 27 92.5


line stmt bran cond sub pod time code
1             # Symbol predicates.
2              
3             # Copyright 2007, 2008, 2009, 2010, 2013, 2015, 2016 Kevin Ryde
4              
5             # This file is part of Chart.
6             #
7             # Chart is free software; you can redistribute it and/or modify it under the
8             # terms of the GNU General Public License as published by the Free Software
9             # Foundation; either version 3, or (at your option) any later version.
10             #
11             # Chart is distributed in the hope that it will be useful, but WITHOUT ANY
12             # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13             # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
14             # details.
15             #
16             # You should have received a copy of the GNU General Public License along
17             # with Chart. If not, see <http://www.gnu.org/licenses/>.
18              
19             package App::Chart::Sympred;
20 1     1   401 use 5.005;
  1         4  
21 1     1   7 use strict;
  1         2  
  1         31  
22 1     1   7 use warnings;
  1         3  
  1         27  
23 1     1   4 use Carp;
  1         1  
  1         44  
24 1     1   4 use Scalar::Util;
  1         2  
  1         24  
25 1     1   4 use List::Util;
  1         1  
  1         39  
26              
27 1     1   285 use App::Chart;
  0            
  0            
28              
29             sub validate {
30             my ($obj) = @_;
31             if (! (Scalar::Util::blessed ($obj) && $obj->isa (__PACKAGE__))) {
32             croak 'Not a symbol predicate: ' . ($obj||'undef');
33             }
34             }
35              
36              
37             #------------------------------------------------------------------------------
38              
39             package App::Chart::Sympred::Equal;
40             use strict;
41             use warnings;
42             use base 'App::Chart::Sympred';
43              
44             sub new {
45             my ($class, $suffix) = @_;
46             return bless { suffix => $suffix }, $class;
47             }
48             sub match {
49             my ($self, $symbol) = @_;
50             return ($symbol eq $self->{'suffix'});
51             }
52              
53             #------------------------------------------------------------------------------
54              
55             package App::Chart::Sympred::Suffix;
56             use 5.006;
57             use strict;
58             use warnings;
59             use base 'App::Chart::Sympred';
60              
61             sub new {
62             my ($class, $suffix) = @_;
63             if ($suffix =~ /\..*\./) {
64             # two or more dots
65             return App::Chart::Sympred::Regexp->new (qr/\Q$suffix\E$/);
66             } else {
67             return bless { suffix => $suffix }, $class;
68             }
69             }
70             sub match {
71             my ($self, $symbol) = @_;
72             return (App::Chart::symbol_suffix ($symbol) eq $self->{'suffix'});
73             }
74              
75             #------------------------------------------------------------------------------
76              
77             package App::Chart::Sympred::Prefix;
78             use strict;
79             use warnings;
80             use base 'App::Chart::Sympred';
81              
82             sub new {
83             my ($class, $prefix) = @_;
84             return bless { prefix => $prefix }, $class;
85             }
86              
87             sub match {
88             my ($self, $symbol) = @_;
89             return ($symbol =~ /^\Q$self->{'prefix'}\E/);
90             }
91              
92             #------------------------------------------------------------------------------
93              
94             package App::Chart::Sympred::Regexp;
95             use strict;
96             use warnings;
97             use base 'App::Chart::Sympred';
98              
99             sub new {
100             my ($class, $pattern) = @_;
101             return bless { pattern => $pattern }, $class;
102             }
103              
104             sub match {
105             my ($self, $symbol) = @_;
106             return ($symbol =~ m/$self->{'pattern'}/);
107             }
108              
109             #------------------------------------------------------------------------------
110              
111             package App::Chart::Sympred::Proc;
112             use strict;
113             use warnings;
114             use base 'App::Chart::Sympred';
115              
116             sub new {
117             my ($class, $proc) = @_;
118             return bless { proc => $proc }, $class;
119             }
120              
121             sub match {
122             my ($self, $symbol) = @_;
123             return &{$self->{'proc'}} ($symbol);
124             }
125              
126             #------------------------------------------------------------------------------
127              
128             package App::Chart::Sympred::Any;
129             use strict;
130             use warnings;
131             use base 'App::Chart::Sympred';
132              
133             sub new {
134             my ($class, @preds) = @_;
135             foreach my $pred (@preds) { App::Chart::Sympred::validate ($pred); }
136             return bless { preds => \@preds }, $class;
137             }
138              
139             sub add {
140             my ($self, @newpreds) = @_;
141             foreach my $pred (@newpreds) { App::Chart::Sympred::validate ($pred); }
142             push @{$self->{'preds'}}, @newpreds;
143             }
144              
145             sub match {
146             my ($self, $symbol) = @_;
147             return List::Util::first { $_->match($symbol) } @{$self->{'preds'}};
148             }
149              
150             1;
151             __END__
152              
153             =for stopwords ie Eg
154              
155             =head1 NAME
156              
157             App::Chart::Sympred -- symbol predicate objects
158              
159             =head1 SYNOPSIS
160              
161             use App::Chart::Sympred;
162             my $sympred = App::Chart::Sympred::Suffix->new ('.AX');
163             $sympred->match('FOO.AX') # returns true
164              
165             =head1 DESCRIPTION
166              
167             A C<App::Chart::Sympred> object represents a predicate for use on stock and
168             commodity symbols, ie. a test of whether a symbol has a certain suffix or
169             similar.
170              
171             =head1 FUNCTIONS
172              
173             =head2 Constructors
174              
175             =over
176              
177             =item C<< $sympred = App::Chart::Sympred::Equal->new ($suffix) >>
178              
179             Return a new C<App::Chart::Sympred> object which matches only the given
180             symbol exactly. Eg.
181              
182             my $sympred = App::Chart::Sympred::Equal->new ('FOO.BAR')
183              
184             =item C<< $sympred = App::Chart::Sympred::Suffix->new ($suffix) >>
185              
186             Return a new C<App::Chart::Sympred> object which matches the given symbol
187             suffix. Eg.
188              
189             my $sympred = App::Chart::Sympred::Suffix->new ('.FOO')
190              
191             =item C<< $sympred = App::Chart::Sympred::Prefix->new ($prefix) >>
192              
193             Return a new C<App::Chart::Sympred> object which matches the given symbol
194             prefix. Eg.
195              
196             my $sympred = App::Chart::Sympred::Prefix->new ('^NZ')
197              
198             =item C<< $sympred = App::Chart::Sympred::Regexp->new (qr/.../) >>
199              
200             Return a new C<App::Chart::Sympred> object which matches the given regexp
201             pattern. Eg.
202              
203             my $sympred = App::Chart::Sympred::Regexp->new (qr/^\^BV|\.SA$/);
204              
205             =item C<< $sympred = App::Chart::Sympred::Proc->new (\&proc) >>
206              
207             Return a new C<App::Chart::Sympred> object which calls the given C<proc>
208             subroutine to test for a match. Eg.
209              
210             sub my_fancy_test {
211             my ($symbol) = @_;
212             return (some zany test on $symbol);
213             }
214             my $sympred = App::Chart::Sympred::Proc->new (\&my_fancy_test);
215              
216             =item C<< $sympred = App::Chart::Sympred::Any->new ($pred,...) >>
217              
218             Return a new C<App::Chart::Sympred> object which is true if any of the given
219             C<$pred> predicates is true. Eg.
220              
221             my $nz = App::Chart::Sympred::Suffix->new ('.NZ')
222             my $bc = App::Chart::Sympred::Suffix->new ('.BC')
223              
224             my $sympred = App::Chart::Sympred::Any->new ($nz, $bc);
225              
226             =back
227              
228             =head2 Methods
229              
230             =over
231              
232             =item C<< $sympred->match ($symbol) >>
233              
234             Return true if C<$symbol> is matched by the C<$sympred> object.
235              
236             =item C<< $sympred->add ($pred,...) >>
237              
238             Add additional predicates to a C<App::Chart::Sympred::Any> object.
239              
240             =item C<< App::Chart::Sympred::validate ($obj) >>
241              
242             Check that C<$obj> is a C<App::Chart::Sympred> object, throw an error if not.
243              
244             =back
245              
246             =head1 HOME PAGE
247              
248             L<http://user42.tuxfamily.org/chart/index.html>
249              
250             =head1 LICENCE
251              
252             Copyright 2007, 2008, 2009, 2010, 2013, 2015, 2016 Kevin Ryde
253              
254             Chart is free software; you can redistribute it and/or modify it under the
255             terms of the GNU General Public License as published by the Free Software
256             Foundation; either version 3, or (at your option) any later version.
257              
258             Chart is distributed in the hope that it will be useful, but WITHOUT ANY
259             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
260             FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
261             details.
262              
263             You should have received a copy of the GNU General Public License along with
264             Chart; see the file F<COPYING>. Failing that, see
265             L<http://www.gnu.org/licenses/>.
266              
267             =cut