File Coverage

blib/lib/Text2URI.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Text2URI;
2 1     1   4365 use Moose;
  0            
  0            
3             use Text::Unaccent::PurePerl qw(unac_string);
4              
5             our $VERSION = "0.4";
6              
7             has old_alphanumeric_regexp => (
8             is => 'rw',
9             isa => 'Int',
10             default => sub {0}
11             );
12              
13             sub translate {
14             my ($self, $text, $sep) = @_;
15             $sep ||= '-';
16              
17             $text = lc unac_string( $text );
18              
19             $text =~ s/^\s+//o;
20             $text =~ s/\s+$//o;
21              
22             if ($self->old_alphanumeric_regexp){
23             $text =~ s/\W+/$sep/go;
24             }else{
25             $text =~ s/[^\w\.]+/$sep/go;
26             }
27             $text =~ s/$sep+/$sep/go;
28             $text =~ s/$sep$//o;
29             $text =~ s/^$sep//o;
30              
31             return $text;
32             }
33              
34             1;
35              
36             __END__
37              
38             =pod
39              
40             =encoding utf-8
41              
42             =head1 NAME
43              
44             Text2URI
45              
46             =head1 VERSION
47              
48             version 0.3001
49              
50             =head1 SYNOPSIS
51              
52             use Text2URI;
53              
54             my $t = new Text2URI();
55              
56             print $t->translate("Atenção SomeText (0)2302-3234 otherthing !!");
57             # atencao-sometext-0-2302-3234-otherthing
58              
59             print $t->translate("Sell your house",'_');
60             # sell_your_house
61              
62             # you can pass C<old_alphanumeric_regexp => 1> to alternate between C<\W+> or C<[^\w\.]+> regexp.
63             # default to old_alphanumeric_regexp => 0 that means C<[^\w\.]+>
64             # you can change it between calls too. $t->old_alphanumeric_regexp(1) to enable.
65              
66              
67             =head1 DESCRIPTION
68              
69             Simple but effective transform text to a "url friendly" string! Just it
70              
71             =head1 NAME
72              
73             Text2URI - Transform text to a "url friendly" string
74              
75              
76             =head1 SEE ALSO
77              
78             Text::Unaccent - Remove accents from a string. I'm using this since v0.3001 because lots of plataforms broken with ASNCI/Translit.
79              
80              
81              
82             =head1 AUTHOR
83              
84             Renato Cron <renato@aware.com.br>
85              
86             =head1 COPYRIGHT AND LICENSE
87              
88             This software is copyright (c) 2012 by Aware TI <http://www.aware.com.br>.
89              
90             This is free software; you can redistribute it and/or modify it under
91             the same terms as the Perl 5 programming language system itself.
92              
93             =cut
94              
95