File Coverage

blib/lib/MojoMojo/Formatter/YouTube.pm
Criterion Covered Total %
statement 32 36 88.8
branch 9 10 90.0
condition 5 5 100.0
subroutine 5 6 83.3
pod 4 4 100.0
total 55 61 90.1


line stmt bran cond sub pod time code
1             package MojoMojo::Formatter::YouTube;
2              
3 26     26   92784 use strict;
  26         63  
  26         753  
4 26     26   458 use parent 'MojoMojo::Formatter';
  26         263  
  26         134  
5              
6             eval {require URI::Fetch};
7             my $dependencies_installed = !$@;
8              
9             =head2 module_loaded
10              
11             Return true if the module is loaded.
12              
13             =cut
14              
15 0     0 1 0 sub module_loaded { $dependencies_installed }
16              
17             our $VERSION = '0.01';
18              
19             =head1 NAME
20              
21             MojoMojo::Formatter::YouTube - Embed YouTube player
22              
23             =head1 DESCRIPTION
24              
25             Embed YouTube video player for given video by writing {{youtube <url>}}.
26              
27             =head1 METHODS
28              
29             =head2 format_content_order
30              
31             Format order can be 1-99. The YouTube formatter runs on 10.
32              
33             =cut
34              
35 744     744 1 1968 sub format_content_order { 10 }
36              
37             =head2 format_content
38              
39             Calls the formatter. Takes a ref to the content as well as the
40             context object.
41              
42             =cut
43              
44             sub format_content {
45 129     129 1 4182 my ( $class, $content, $c ) = @_;
46              
47 129         875 my @lines = split /\n/, $$content;
48 129         385 $$content = "";
49 129         870 my $re = $class->gen_re(qr/youtube\s+(.*?)/);
50 129 100 100     948 my $lang = $c->sessionid ? $c->session->{lang} : $c->pref('default_lang') || 'en';
51              
52 129         27514 foreach my $line (@lines) {
53 666 100       2840 if ( $line =~ m/$re/ ) {
54 5         17 $line = $class->process($c, $line, $re, $lang);
55             }
56 666         1915 $$content .= $line . "\n";
57             }
58              
59             }
60              
61             =head2 process
62              
63             Do the meat of inserting a youtube movie into a wiki page.
64              
65             =cut
66              
67             sub process {
68 5     5 1 17 my ( $class, $c, $line, $re, $lang) = @_;
69              
70 5         21 my $youtube = $c->loc('YouTube Video');
71 5         487 my $video_id;
72 5         40 $line =~ m/$re/;
73 5         27 my $url = URI->new($1);
74              
75 5 50       639 unless ($url){
76 0         0 $line =~ s/$re/"$youtube: $url ".$c->loc('is not a valid url')/e;
  0         0  
77 0         0 return $line;
78             }
79              
80 5 100       55 if ($url =~ m!youtube.com/.*?v=([A-Za-z0-9_-]+)!){
81 4         86 $video_id=$1;
82             } else {
83 1         13 $line =~ s/$re/"$youtube: $url ".$c->loc('is not a valid link to youtube video')/e;
  1         6  
84 1         14 return $line;
85             }
86              
87 4 100 100     36 if ( ($c->action->reverse eq 'pageadmin/edit') || ($c->action->reverse eq 'jsrpc/render') ){
88 3         151 $line =~ s!$re!<div style='width: 425px;height: 344px; border: 1px black dotted;'>$youtube<br /><a href="$url">$url</a></div>!;
89 3         92 $c->stash->{precompile_off} = 1;
90             } else {
91 1         25 $line =~ s!$re!<object width="425" height="344"><param name="movie" value="http://www.youtube.com/v/$video_id&amp;hl=$lang"></param><param name="allowFullScreen" value="true"></param><param name="allowscriptaccess" value="always"></param><embed src="http://www.youtube.com/v/$video_id&amp;hl=$lang" type="application/x-shockwave-flash" allowscriptaccess="always" allowfullscreen="true" width="425" height="344"></embed></object>!;
92             }
93 4         118 return $line;
94             }
95              
96             =head1 SEE ALSO
97              
98             L<MojoMojo>, L<Module::Pluggable::Ordered>, L<URI::Fetch>
99              
100             =head1 AUTHORS
101              
102             Robert 'LiNiO' Litwiniec <linio@wonder.pl>
103              
104             =head1 LICENSE
105              
106             This library is free software. You can redistribute it and/or modify
107             it under the same terms as Perl itself.
108              
109             =cut
110              
111             1;