File Coverage

blib/lib/Data/iRealPro/Output/HTML.pm
Criterion Covered Total %
statement 63 97 64.9
branch 10 36 27.7
condition 4 17 23.5
subroutine 15 15 100.0
pod 0 3 0.0
total 92 168 54.7


line stmt bran cond sub pod time code
1             #! perl
2              
3             # Data::iRealPro::Output::HTML -- produce iRealPro HTML data
4              
5             # Author : Johan Vromans
6             # Created On : Fri Sep 30 19:36:29 2016
7             # Last Modified By: Johan Vromans
8             # Last Modified On: Tue Nov 6 08:31:11 2018
9             # Update Count : 61
10             # Status : Unknown, Use with caution!
11              
12             ################ Common stuff ################
13              
14 3     3   3954 use strict;
  3         7  
  3         105  
15 3     3   18 use warnings;
  3         5  
  3         77  
16 3     3   15 use Carp;
  3         5  
  3         141  
17 3     3   1137 use utf8;
  3         32  
  3         15  
18              
19             package Data::iRealPro::Output::HTML;
20              
21 3     3   127 use parent qw( Data::iRealPro::Output::Base );
  3         6  
  3         19  
22              
23 3     3   144 use Data::iRealPro::URI;
  3         6  
  3         68  
24 3     3   17 use Data::iRealPro::Playlist;
  3         4  
  3         70  
25 3     3   16 use Encode qw( encode_utf8 );
  3         5  
  3         119  
26 3     3   15 use HTML::Entities;
  3         6  
  3         183  
27 3     3   21 use File::Path qw( make_path );
  3         5  
  3         3276  
28              
29             my $regtest = $ENV{IRP_REGTEST};
30              
31             sub options {
32 2     2 0 5 my $self = shift;
33 2         4 [ @{ $self->SUPER::options }, qw( split dir ) ];
  2         13  
34             }
35              
36             sub process {
37 2     2 0 2241 my ( $self, $u, $options ) = @_;
38              
39 2 50       13 unless ( $self->{split} ) {
40              
41 2   50     19 $self->{output} ||= $options->{output} || "__new__.html";
      33        
42              
43 2 50       8 if ( $u->{transpose} ) {
44 0         0 foreach my $song ( @{ $u->{playlist}->{songs} } ) {
  0         0  
45             # Do not change key to actual.
46 0         0 local $song->{_transpose} = 0;
47              
48 0   0     0 $song->{key} = $song->xpose($song->{key} // "C");
49 0 0       0 if ( $song->{actual_key} ne '' ) {
50             $song->{actual_key} =
51 0         0 ( $song->{actual_key} + $song->{transpose} ) % 12;
52             }
53 0         0 $song->tokenize;
54 0 0       0 $song->{data} = $song->{dataxp} if $song->{dataxp};
55             }
56             }
57              
58 2 50       8 if ( ref( $self->{output} ) ) {
59 2         7 ${ $self->{output} } = to_html($u);
  2         10  
60             }
61             else {
62             open( my $fd, ">:utf8", $self->{output} )
63 0 0       0 or croak( "Cannot create ", $self->{output}, " [$!]\n" );
64 0         0 print $fd to_html($u);
65 0         0 close($fd);
66             }
67 2         8 return;
68             }
69              
70 0   0     0 my $outdir = $self->{dir} || "";
71 0 0 0     0 $outdir .= "/" if $outdir && $outdir !~ m;/$;;
72 0 0       0 make_path( $outdir, {} ) unless -d $outdir;
73              
74 0         0 foreach my $song ( @{ $u->{playlist}->{songs} } ) {
  0         0  
75             # Do not change key to actual.
76 0         0 local $song->{_transpose} = 0;
77              
78 0 0       0 if ( $song->{transpose} ) {
79 0   0     0 $song->{key} = $song->xpose($song->{key} // "C");
80 0 0       0 if ( $song->{actual_key} ne '' ) {
81             $song->{actual_key} =
82 0         0 ( $song->{actual_key} + $song->{transpose} ) % 12;
83             }
84 0         0 $song->tokenize;
85 0 0       0 $song->{data} = $song->{dataxp} if $song->{dataxp};
86             }
87              
88             # Make a playlist with just this song.
89 0         0 my $pls = Data::iRealPro::Playlist->new( song => $song );
90              
91             # Make an URI for this playlist.
92 0         0 my $uri = Data::iRealPro::URI->new( playlist => $pls );
93              
94             # Write it out.
95 0         0 my $title = $song->{title};
96             # Mask dangerous characters.
97 0         0 $title =~ s/[:?\\\/*"<>|]/@/g;
98 0         0 my $file = $outdir.$title.".html";
99 0         0 my $out = encode_utf8($file);
100 0 0       0 open( my $fd, '>:utf8', $out )
101             or die( "$out: $!\n" );
102 0         0 print $fd to_html($uri);
103 0         0 close($fd);
104             warn( "Wrote $out\n" )
105 0 0       0 if $self->{verbose};
106             }
107             }
108              
109             sub to_html {
110 2     2 0 6 my ( $u ) = @_;
111              
112 2         5 my $pl = $u->{playlist};
113 2         2 my $title;
114 2 100       10 if ( $pl->{name} ) {
115 1         4 $title = _html($pl->{name});
116             }
117             else {
118 1         4 $title = _html($pl->{songs}->[0]->{title});
119             }
120 2 50       58 my $vv = $regtest ? "" : " version $Data::iRealPro::VERSION";
121 2         13 my $html = <
122            
123            
124            
125            
126             $title
127            
142            
143            
144            

$title
145             EOD
146              
147 2 100 66     10 if ( $pl->{name} || @{ $pl->{songs} } > 1 ) {
  1         5  
148 1         7 $html .= "

as_string(1) .

149             "\" target=\"_blank\">(All songs)

\n
    \n";
150 1         3 foreach my $s ( @{ $pl->{songs} } ) {
  1         4  
151 2         26 my @c = split(' ', $s->{composer});
152 2 50       9 my $c = @c == 2 ? "$c[1] $c[0]" : $s->{composer};
153             $html .= "
    • 154             _esc($s->as_string) .
    155             "\" target=\"_blank\">" .
    156             _html($s->{title}) .
    157             " - " .
    158             _html($c) .
    159 2 50       9 ( $s->{ts} ? " (@{[$s->{ts}]})" : "" ) .
      0         0  
    160             "\n";
    161             }
    162              
    163 1         17 $html .= " \n";
    164             }
    165             else {
    166 1         2 $html .= qq{

    $title

    \n};
      1         5  
    167             }
    168              
    169 2         25 $html .= <
    170            

    Generated by Data::iRealPro$vv.
    171            
    172            
    173             EOD
    174             }
    175              
    176             sub _esc {
    177 2     2   33 goto \&Data::iRealPro::URI::esc;
    178             }
    179              
    180             sub _html {
    181 6     6   67 encode_entities($_[0]);
    182             }
    183              
    184             1;