File Coverage

blib/lib/MojoMojo/Formatter/GoogleSearch.pm
Criterion Covered Total %
statement 39 42 92.8
branch 8 10 80.0
condition 4 4 100.0
subroutine 6 6 100.0
pod 3 3 100.0
total 60 65 92.3


line stmt bran cond sub pod time code
1             package MojoMojo::Formatter::GoogleSearch;
2 27     27   73848 use strict;
  27         78  
  27         723  
3 27     27   133 use warnings;
  27         66  
  27         788  
4 27     27   465 use parent qw/MojoMojo::Formatter/;
  27         330  
  27         153  
5              
6             =head1 NAME
7              
8             MojoMojo::Formatter::GoogleSearch - Linked Google Search Engine by writing {{google:<search kind> <keyword>}}
9              
10             =cut
11              
12             my $CONF = {
13             web => {
14             base => 'http://www.google.com/search',
15             },
16             image => {
17             base => 'http://www.google.com/images',
18             },
19             movie => {
20             base => 'http://www.google.com/search',
21             param => {
22             tbs => 'vid:1',
23             },
24             },
25             };
26              
27             =head1 DESCRIPTION
28              
29             Normally, to hyperlink to a Search Engine, you'd write:
30              
31             [google SearchWord](http://www.google.com/search?q=SearchWord)
32              
33             This plugin lets you write just
34              
35             {{google SearchWord}}
36              
37             not just Search Web, you can search images and movies
38              
39             {{google:image SearchWord}}
40             {{google:movie SearchWord}}
41              
42             =head1 METHODS
43              
44             =head2 format_content_order
45              
46             The SearchEngine formatter has no special requirements
47             in terms of the order it gets run in, so it has a priority of 16.
48              
49             =cut
50              
51 620     620 1 2395 sub format_content_order { 16 }
52              
53             =head2 format_content
54              
55             Calls the formatter. Takes a ref to the content as well as the context object.
56              
57             =cut
58              
59             sub format_content {
60 131     131 1 5386 my ( $class, $content, $c ) = @_;
61              
62 131 50       845 return unless $class->module_loaded;
63              
64 131         834 my @lines = split /\n/, $$content;
65 131         348 $$content = '';
66              
67 131         740 my $re = $class->gen_re( qr/google:?([^\s]+)?\s+(.+)/ );
68             my $lang = $c->sessionid
69 131 100 100     852 ? $c->session->{lang} : $c->pref('default_lang') || 'en';
70              
71 131         26515 for my $line (@lines) {
72 737 100       2694 if ( $line =~ m/$re/ ) {
73 7         21 $line = $class->process($c, $line, $re, $lang);
74             }
75 737         1968 $$content .= $line . "\n";
76             }
77              
78             }
79              
80             =head2 process
81              
82             Here the actual formatting is done.
83              
84             =cut
85             sub process {
86 7     7 1 13 my $class = shift;
87 7         15 my ($c, $line, $re, $lang) = @_;
88              
89 7         19 my $google_search = $c->loc('Google Search Link');
90              
91 7         58 $line =~ m/$re/;
92 7   100     32 my $kind = $1 || 'web';
93 7         16 my $keyword = $2;
94              
95 7 50       21 unless ($CONF->{$kind}->{base}) {
96 0         0 $line =~ s/$re/"$google_search: ". $c->loc('invalid Kind of Search')/e;
  0         0  
97 0         0 return $line;
98             }
99              
100 7         13 my %param;
101 7         18 $param{q} = $keyword;
102 7 100       20 if ($CONF->{$kind}->{param}) {
103 2         3 for my $key (keys %{ $CONF->{$kind}->{param} }) {
  2         9  
104 2         7 $param{$key} = $CONF->{$kind}->{param}->{$key};
105             }
106             }
107              
108 7         90 my $uri = URI->new($CONF->{$kind}->{base});
109 7         611 $uri->query_form( map {$_ => $param{$_} } sort keys %param );
  9         44  
110              
111 7         941 $line =~ s!$re!<a href="$uri">$keyword</a>!;
112 7         62 $c->stash->{precompile_off} = 1;
113              
114 7         69 return $line;
115             }
116              
117              
118             =head1 SEE ALSO
119              
120             L<MojoMojo> and L<Module::Pluggable::Ordered>.
121              
122             =head1 AUTHORS
123              
124             Dai Okabayashi, L<bayashi at cpan . org>
125              
126             =head1 LICENSE
127              
128             This library is free software. You can redistribute it and/or modify
129             it under the same terms as Perl itself.
130              
131             =cut
132              
133             1;