File Coverage

blib/lib/URI/Find/UTF8/ExtraCharacters.pm
Criterion Covered Total %
statement 18 18 100.0
branch n/a
condition 2 2 100.0
subroutine 5 5 100.0
pod 2 2 100.0
total 27 27 100.0


line stmt bran cond sub pod time code
1             package URI::Find::UTF8::ExtraCharacters;
2             $URI::Find::UTF8::ExtraCharacters::VERSION = '0.01_002';
3 7     7   126374 use strict;
  7         11  
  7         176  
4 7     7   26 use warnings;
  7         7  
  7         180  
5              
6 7     7   23 use base 'URI::Find::UTF8';
  7         10  
  7         2802  
7             =head1 NAME
8              
9             URI::Find::UTF8::ExtraCharacters - URI::Find::UTF8 with optional extra characters.
10              
11             =head1 SYNOPSIS
12              
13             my $finder = URI::Find::UTF8::ExtraCharacters->new( sub {
14             my ( $uri_obj, $url ) = @_;
15             return "$uri_obj";
16             },
17             extra_characters => ['|'],
18             );
19             my $text = "link to zombo: http://zombo.com/lorem|ipsum?queryparam=queryval";
20             $finder->find(\$text);
21             say $text; #link to zombo: http://zombo.com/lorem%7Cipsum?queryparam=queryval
22              
23             =head1 DESCRIPTION
24              
25             The web is a wacky place full of screwed up URLs. This is a drop in replacement for L
26             ( Which is a drop in replacement for L ) which allows you to pass in additional characters that
27             URI::Find thinks are bogus. ( like '|' )
28              
29             =head2 Public Methods
30              
31             =over 4
32              
33             =item B
34              
35             my $finder = URI::Find::UTF8::ExtraCharacters->new(\&callback,
36             extra_characters => \@chars );
37              
38             Creates a new URI::Find::UTF8::ExtraCharacters object.
39              
40             =back
41              
42             =cut
43              
44             sub uric_set {
45 72     72 1 101567 my $self = shift;
46 72         75 join('', map { quotemeta($_) } @{ $self->{_extra_characters} } )
  3         26  
  72         211  
47             . $self->SUPER::uric_set;
48             }
49              
50             sub new {
51 19     19 1 33314 my($class,$callback,%params) = @_;
52 19   100     108 my $extra_characters = $params{extra_characters} || [];
53 19         98 my $self = $class->SUPER::new($callback);
54 19         209 $self->{_extra_characters} = $extra_characters;
55 19         37 return $self;
56             }
57              
58             =head1 INCOMPATIBILITIES
59              
60             This module does not export 'find_uris,' which L does but L does not.
61              
62             =head1 AUTHOR
63              
64             Samuel Kaufman, skaufman-at-cpan.org
65              
66             =head1 LICENSE
67              
68             Copyright 2014 by Samuel Kaufman
69              
70             This program is free software; you can redistribute it and/or
71             modify it under the same terms as Perl itself.
72              
73             See F
74              
75             =cut
76              
77             1;