File Coverage

blib/lib/SWISH/Filters/ID3toHTML.pm
Criterion Covered Total %
statement 9 65 13.8
branch 0 26 0.0
condition 0 20 0.0
subroutine 3 10 30.0
pod 1 8 12.5
total 13 129 10.0


line stmt bran cond sub pod time code
1             package SWISH::Filters::ID3toHTML;
2 1     1   549 use strict;
  1         1  
  1         32  
3 1     1   3 use vars qw( $VERSION @ISA );
  1         2  
  1         745  
4             $VERSION = '0.191';
5             @ISA = ('SWISH::Filters::Base');
6              
7             # Convert known ID3v2 tags to metanames.
8              
9             my %id3v2_tags = (
10             TIT2 => 'song', # 4.2.1 TIT2 Title/songname/content description
11             TYER => 'year', # 4.2.1 TYER Year
12             TRCK => 'track', # 4.2.1 TRCK Track number/Position in set
13             TCOP => 'copyright', # 4.2.1 TCOP Copyright message
14             # * WinAMP seems to prepend a (C) to this value.
15              
16             TPE1 => 'artist', # 4.2.1 TPE1 Lead performer(s)/Soloist(s)
17             TALB => 'album', # 4.2.1 TALB Album/Movie/Show title
18             TENC => 'encoded', # 4.2.1 TENC Encoded by
19             TOPE => 'artist_original', # 4.2.1 TOPE Original artist(s)/performer(s)
20             TCOM => 'composer', # 4.2.1 TCOM Composer
21             TCON => 'genre', # 4.2.1 TCON Content type
22              
23             # 4.3.2 WXXX User defined URL link frame
24             WXXX_URL => 'url', # * URL => http://URL/HERE
25             WXXX_Description =>
26             'url_description', # * Description => WinAMP provides no description
27              
28             # 4.11 COMM Comments
29             COMM_Text => 'comment', # * Text => COMMENT
30             COMM_Language => 'comment_lang', # * Language => eng
31             COMM_short => 'comment_short' # * short => WinAMP provides no short
32              
33             );
34              
35             sub new {
36 1     1 0 16 my ($class) = @_;
37              
38 1         5 my $self = bless { mimetypes => [qr!audio/mpeg!], }, $class;
39 1         7 return $self->use_modules(qw( MP3::Tag ));
40             }
41              
42             sub filter {
43 0     0 1   my ( $self, $doc ) = @_;
44              
45             # We need a file name to pass to the conversion function
46 0           my $file = $doc->fetch_filename;
47              
48 0           my ( $content_ref, $meta ) = $self->get_id3_content_ref( $file, $doc );
49 0 0         return unless $content_ref;
50              
51             # update the document's content type
52 0           $doc->set_content_type('text/html');
53              
54             # If filtered must return either a reference to the doc or a pathname.
55 0           return ( \$content_ref, $meta );
56             }
57              
58             # =======================================================================
59             sub get_id3_content_ref {
60 0     0 0   my ( $self, $filename, $doc ) = @_;
61 0           my $mp3 = MP3::Tag->new($filename);
62              
63             # return unless we have a file with tags
64 0 0 0       return format_empty_doc($filename)
65             unless ref $mp3 && $mp3->get_tags();
66              
67             # Here we will store all of the tag info
68 0           my %metadata;
69              
70             # Convert tags to metadata giving ID3v2 precedence
71 0           get_id3v1_tags( $mp3, \%metadata );
72              
73             # will replace any v1 tags that are the same
74 0           get_id3v2_tags( $mp3, \%metadata );
75              
76 0   0       my $user_meta = $doc->meta_data || {};
77 0           $metadata{$_} = $user_meta->{$_} for keys %$user_meta;
78              
79             # HTML or bust
80             return (
81 0 0         %metadata
82             ? $self->format_as_html( \%metadata )
83             : $self->format_empty_doc($filename)
84             );
85             }
86              
87             sub get_id3v1_tags {
88 0     0 0   my ( $mp3, $metadata ) = @_;
89              
90 0 0         return unless exists $mp3->{ID3v1};
91              
92             # Read all ID3v1 tags into metadata hash
93 0           my $id3v1 = $mp3->{ID3v1};
94 0           for (qw/ artist album comment genre song track year /) {
95 0 0         $metadata->{$_} = $id3v1->$_ if $id3v1->$_;
96             }
97             }
98              
99             sub get_id3v2_tags {
100 0     0 0   my ( $mp3, $metadata ) = @_;
101              
102             # Do we even have an ID3 v2 tag?
103 0 0         return unless exists $mp3->{ID3v2};
104              
105             # Get the tag and a hash of frame ids.
106 0           my $id3v2 = $mp3->{ID3v2};
107              
108             # keys are 4-character-codes and values are the long names
109 0           my $frameIDs_hash = $id3v2->get_frame_ids;
110              
111             # Go through each frame and translate it to usable metadata
112 0           foreach my $frame ( keys %$frameIDs_hash ) {
113 0           my ( $info, $name ) = $id3v2->get_frame($frame);
114              
115             # We have a user defined frame
116 0 0         if ( ref $info ) {
117              
118             # $$$ We really only want COMM and WXXX
119 0           while ( my ( $key, $val ) = each %$info ) {
120              
121             next
122 0 0 0       if $key =~ /^_/
123             || !$val; # leading underscore means binary data
124              
125             # Concatenate frame and key for our lookup hash
126 0           my $code = ${frame} . "_" . ${key};
127              
128             # fails when frame is appended with digits (e.g. "COMM01");
129 0   0       my $metaname = $id3v2_tags{$code} || $code;
130              
131             # Assign value if not empty and has a key
132 0 0         $metadata->{$metaname} = $val if $val;
133             }
134             }
135              
136             # We have a simple frame
137             else {
138 0   0       my $metaname = $id3v2_tags{$frame} || $frame || 'blank frame';
139 0 0         $metadata->{$metaname} = $info if $info;
140             }
141             }
142             }
143              
144             sub format_as_html {
145 0     0 0   my $self = shift;
146 0           my $metadata = shift;
147              
148 0   0       my $title
149             = $metadata->{song}
150             || $metadata->{album}
151             || $metadata->{artist}
152             || 'No Title';
153              
154 0           my $headers = $self->format_meta_headers($metadata);
155              
156 0           my $url = '';
157 0 0         if ( $metadata->{url} ) {
158 0   0       my $desc = $metadata->{url_description} || $metadata->{url};
159 0           $url
160             = '

161

            . $self->escapeXML( $metadata->{url} )
162             . "\">$desc";
163             }
164              
165 0           my $comment = '';
166 0 0         if ( $metadata->{comment} ) {
167 0   0       my $lang = get_iso_lang( $metadata->{comment_lang} || 'en' )
168             ; # wrong assuming "en"?
169 0           $comment = qq[

]

170             . $self->escapeXML( $metadata->{comment} ) . '

';
171             }
172              
173 0           my $txt = <
174            
175            
176             $title
177             $headers
178            
179            
180             $url
181             $comment
182            
183            
184             EOF
185              
186 0           return ( $txt, $metadata );
187              
188             }
189              
190             sub format_empty_doc {
191 0     0 0   my $self = shift;
192 0           my $filename = shift;
193 0           require File::Basename;
194 0           my $base = File::Basename::basename( $filename, '.mp3' );
195              
196 0           return $self->format_as_html( { song => $base, notag => 1 } );
197             }
198              
199             sub get_iso_lang {
200 0     0 0   my $lang = shift;
201              
202             # Do we need to translate undocumented ID3 Lang codes to ISO?
203             # 4.11.Comments
204             # Language $xx xx xx
205             # * WinAMP may be mistaken for using "eng" instead of an ISO designator
206              
207 0 0         return $lang unless $lang == "eng";
208 0           return "en";
209             }
210              
211             1;
212             __END__