File Coverage

blib/lib/Weasel/FindExpanders.pm
Criterion Covered Total %
statement 14 30 46.6
branch 1 8 12.5
condition 0 2 0.0
subroutine 5 6 83.3
pod 2 2 100.0
total 22 48 45.8


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Weasel::FindExpanders - Mapping find patterns to xpath locators
5              
6             =head1 VERSION
7              
8             0.01
9              
10             =head1 SYNOPSIS
11              
12             use Weasel::FindExpanders qw( register_find_expander );
13              
14             register_find_expander(
15             'button',
16             'HTML',
17             sub {
18             my %args = @_;
19             $args{text} =~ s/'/''/g; # quote the quotes (XPath 2.0)
20             return ".//button[text()='$args{text}']";
21             });
22              
23             $session->find($session->page, "@button|{text=>\"whatever\"}");
24              
25             =cut
26              
27             =head1 DESCRIPTION
28              
29             =cut
30              
31             =head1 DEPENDENCIES
32              
33              
34              
35             =cut
36              
37             package Weasel::FindExpanders;
38              
39 2     2   14 use strict;
  2         13  
  2         62  
40 2     2   10 use warnings;
  2         4  
  2         56  
41              
42 2     2   10 use base 'Exporter';
  2         3  
  2         233  
43 2     2   12 use Carp;
  2         8  
  2         854  
44              
45             our @EXPORT_OK = qw| register_find_expander expand_finder_pattern |;
46              
47             =head1 SUBROUTINES/METHODS
48              
49             =over
50              
51             =item register_find_expander($pattern_name, $group_name, &expander_function)
52              
53             Registers C<&expander_function> as an expander for C<$pattern_name> in
54             C<$group_name>.
55              
56             C<Weasel::Session> selects the expanders to be applied using its C<groups>
57             attribute.
58              
59             =cut
60              
61              
62             # Stores handlers as arrays per group
63             my %find_expanders;
64              
65             sub register_find_expander {
66 0     0 1 0 my ($pattern_name, $group, $expander_function) = @_;
67              
68 0         0 return push @{$find_expanders{$group}{$pattern_name}}, $expander_function;
  0         0  
69             }
70              
71             =item expand_finder_pattern($pattern, $args, $groups)
72              
73             Returns a string of concatenated (using xpath '|' operator) expansions.
74              
75             When C<$groups> is undef, all groups will be searched for C<pattern_name>.
76              
77             If the pattern doesn't match '*<pattern_name>|{<arguments>}', the pattern
78             is returned as the only list/arrayref element.
79              
80             =cut
81              
82             sub expand_finder_pattern {
83 2     2 1 6 my ($pattern, $args, $groups) = @_;
84              
85             ##no critic(ProhibitCaptureWithoutTest)
86 2 50       9 return $pattern
87             if ! ($pattern =~ m/^\*([^\|]+)/x);
88 0           my $name = $1;
89             ##critic(ProhibitCaptureWithoutTest)
90              
91 0 0         croak "No expansions registered (while expanding '$pattern')"
92             if scalar(keys %find_expanders) == 0;
93              
94 0   0       $groups //= [ keys %find_expanders ]; # undef --> unrestricted
95             # Using eval below to transform a hash-in-string to a hash efficiently
96              
97 0           my @matches;
98              
99 0           for my $group (@{$groups}) {
  0            
100 0 0         next if ! exists $find_expanders{$group}{$name};
101              
102             push @matches,
103 0           reverse map { $_->(%{$args}) } @{$find_expanders{$group}{$name}};
  0            
  0            
  0            
104             }
105              
106 0 0         croak "No expansions matching '$pattern'"
107             if ! @matches;
108              
109 0           return join "\n|", @matches;
110             }
111              
112             =back
113              
114             =cut
115              
116             =head1 AUTHOR
117              
118             Erik Huelsmann
119              
120             =head1 CONTRIBUTORS
121              
122             Erik Huelsmann
123             Yves Lavoie
124              
125             =head1 MAINTAINERS
126              
127             Erik Huelsmann
128              
129             =head1 BUGS AND LIMITATIONS
130              
131             Bugs can be filed in the GitHub issue tracker for the Weasel project:
132             https://github.com/perl-weasel/weasel/issues
133              
134             =head1 SOURCE
135              
136             The source code repository for Weasel is at
137             https://github.com/perl-weasel/weasel
138              
139             =head1 SUPPORT
140              
141             Community support is available through
142             L<perl-weasel@googlegroups.com|mailto:perl-weasel@googlegroups.com>.
143              
144             =head1 LICENSE AND COPYRIGHT
145              
146             (C) 2016-2023 Erik Huelsmann
147              
148             Licensed under the same terms as Perl.
149              
150             =cut
151              
152              
153             1;
154