« back to all changes in this revision
Viewing changes to src/ext/FileMagic.pm
- browse files at revision 3
- compare with another revision
- download diff
- download tarball
- view history from revision 3
- Committer: Bazaar Package Importer
- Author(s): Barry deFreese
- Date: 2005-09-17 14:41:08 UTC
- mfrom: (2.1.1 sarge)
- Revision ID: james.westby@ubuntu.com-20050917144108-fxrlryh8zv6bhv50
Tags: 0.98-3ubuntu1
src/ext/FooBar.pm, change call from gnupod_otgsync to gnupod_otgsync.pl
- files added:
- .gnupod_version
- TNG
- man
- files removed:
- Makefile
- files modified:
- BUGS
- CHANGES *
- doc/fdl.texi *
added
removed
src/ext/FileMagic.pm
1
1
package GNUpod::FileMagic;
2
# Copyright (C) 2002-2004 Adrian Ulrich <pab at blinkenlights.ch>
2
# Copyright (C) 2002-2005 Adrian Ulrich <pab at blinkenlights.ch>
3
3
# Part of the gnupod-tools collection
4
4
#
5
5
# URL: http://www.gnu.org/software/gnupod/
27
27
use GNUpod::FooBar;
28
28
use GNUpod::QTfile;
29
29
30
#
31
# How to add a converter:
32
# 1. Define the first 4 bytes in NN_HEADERS
33
# 2. write a decoder: gnupod_convert_BLA.pl
34
# done!
35
#
36
37
my $NN_HEADERS = {'MThd' => { encoder=>'gnupod_convert_MIDI', ftyp=>'MIDI'},
38
'fLaC' => { encoder=>'gnupod_convert_FLAC', ftyp=>'FLAC'},
39
'OggS' => { encoder=>'gnupod_convert_OGG', ftyp=>'OGG'}};
40
41
42
43
30
44
BEGIN {
31
45
MP3::Info::use_winamp_genres();
32
MP3::Info::use_mp3_utf8(0);
33
open(NULLFH, "> /dev/null") or die "Could not open /dev/null, $!\n";
46
47
if($MP3::Info::VERSION >= 1.01) { #Check for very old MP3::Info versions
48
MP3::Info::use_mp3_utf8(0);
49
}
50
else {
51
warn "FileMagic.pm: Warning: You are using a VERY OLD ($MP3::Info::VERSION) Version\n";
52
warn " of MP3::Info. ** DISABLING UNICODE SUPPORT BECAUSE IT WOULD BREAK **\n";
53
warn " PLEASE UPGRADE TO 1.01 OR NEWER (See: http://search.cpan.org)\n";
54
}
55
56
open(NULLFH, "> /dev/null") or die "Could not open /dev/null, $!\n";
34
57
}
35
58
36
59
########################################################################
37
60
#Try to discover the file format (mp3 or QT (AAC) )
61
# Returns: (FILE_HASH{artist,album..}, MEDIA_HASH{ftyp,format,extension}, DECODER_SCALAR)
38
62
sub wtf_is {
39
my($file, %opts) = @_;
40
63
my($file, $flags, $con) = @_;
64
41
65
if(-d $file) { #Don't add dirs
42
66
warn "FileMagic.pm: '$file' is a directory!\n";
43
67
}
44
68
elsif(!-r $file) {
45
69
warn "FileMagic.pm: Can't read '$file'\n";
46
70
}
47
elsif(my $h = __is_mp3($file, %opts)) {
48
return $h;
49
}
50
elsif(my $h = __is_pcm($file)) {
51
return $h
52
}
53
elsif(my $h = __is_qt($file)) {
54
return $h
55
}
71
elsif(my $nnat = __is_NonNative($file,$flags,$con)) { #Handle non-native formats
72
return($nnat->{ref}, {ftyp=>$nnat->{codec}}, $nnat->{encoder});
73
}
74
elsif(my $xqt = __is_qt($file,$flags)) {
75
return ($xqt->{ref}, {ftyp=>$xqt->{codec}, format=>"m4a", extension=>"m4a|m4p|m4b"});
76
}
77
elsif(my $h = __is_mp3($file,$flags)) {
78
return ($h, {ftyp=>"MP3", format=>"mp3"});
79
}
80
elsif(my $h = __is_pcm($file,$flags)) {
81
return ($h, {ftyp=>"PCM", format=>"wav"});
82
}
83
56
84
#Still no luck..
57
return undef;
58
}
85
return (undef, undef, undef);
86
}
87
88
########################################################################
89
#Handle Non-Native files :)
90
sub __is_NonNative {
91
my($file, $flags, $con) = @_;
92
return undef unless $flags->{decode}; #Decoder is OFF per default!
93
94
open(TNN, $file) or return undef;
95
my $buff = undef;
96
read(TNN,$buff,4);
97
close(TNN);
98
99
my $encoder = $NN_HEADERS->{$buff}->{encoder};
100
return undef unless $encoder; #Nope
101
102
#Still here? -> We know how to decode this stuff
103
my $metastuff = converter_readmeta($encoder, $file, $con);
104
return undef unless ref($metastuff) eq "HASH"; #Failed .. hmm
105
106
my %rh = ();
107
my $cf = ((split(/\//,$file))[-1]);
108
my @songa = pss($metastuff->{_TRACKNUM});
109
110
111
$rh{artist} = getutf8($metastuff->{_ARTIST} || "Unknown Artist");
112
$rh{album} = getutf8($metastuff->{_ALBUM} || "Unknown Album");
113
$rh{title} = getutf8($metastuff->{_TITLE} || $cf || "Unknown Title");
114
$rh{genre} = getutf8($metastuff->{_GENRE} || "");
115
$rh{songs} = int($songa[1]);
116
$rh{songnum} = int($songa[0]);
117
$rh{comment} = getutf8($metastuff->{_COMMENT} || $metastuff->{FORMAT}." file");
118
$rh{fdesc} = getutf8($metastuff->{_VENDOR} || "Converted using $encoder");
119
120
121
return {ref=>\%rh, encoder=>$encoder, codec=>$NN_HEADERS->{$buff}->{ftyp} };
122
}
123
124
59
125
60
126
61
127
#######################################################################
64
130
my($file) = @_;
65
131
my $ret = GNUpod::QTfile::parsefile($file);
66
132
return undef unless $ret; #No QT file
67
133
68
134
my %rh = ();
69
if($ret->{time} < 0) {
70
warn "QTfile parsing failed, invalid time!\n";
135
if($ret->{time} < 1) {
136
warn "QTfile parsing failed, (expected $ret->{time} >= 0)!\n";
71
137
warn "You found a bug - send an email to: pab\@blinkenlights.ch\n";
72
138
return undef;
73
139
}
74
140
75
141
my $cf = ((split(/\//,$file))[-1]);
76
77
$rh{time} = int($ret->{time});
78
$rh{filesize} = int($ret->{filesize});
79
$rh{fdesc} = getutf8($ret->{fdesc});
80
$rh{artist} = getutf8($ret->{artist} || "Unknown Artist");
81
$rh{album} = getutf8($ret->{album} || "Unknown Album");
82
$rh{title} = getutf8($ret->{title} || $cf || "Unknown Title");
83
return \%rh;
142
$rh{songs} = int($ret->{tracks});
143
$rh{songnum} = int($ret->{tracknum});
144
$rh{cds} = int($ret->{cds});
145
$rh{cdnum} = int($ret->{cdnum});
146
$rh{srate} = int($ret->{srate});
147
$rh{time} = int($ret->{time});
148
$rh{bitrate} = int($ret->{bitrate});
149
$rh{filesize} = int($ret->{filesize});
150
$rh{fdesc} = getutf8($ret->{fdesc});
151
$rh{artist} = getutf8($ret->{artist} || "Unknown Artist");
152
$rh{album} = getutf8($ret->{album} || "Unknown Album");
153
$rh{title} = getutf8($ret->{title} || $cf || "Unknown Title");
154
$rh{genre} = getutf8($ret->{genre} || "");
155
$rh{composer} = getutf8($ret->{composer} || "");
156
$rh{soundcheck}= _parse_iTunNORM($ret->{iTunNORM});
157
return ({codec=>$ret->{_CODEC}, ref=>\%rh});
84
158
}
85
159
86
160
######################################################################
95
169
read(PCM, $gid, 4);
96
170
seek(PCM, 8, 0);
97
171
read(PCM, $rty, 4);
98
172
99
173
return undef unless($gid eq "RIFF" && $rty eq "WAVE");
100
174
#Ok, maybe a wave file.. try to get BPS and SRATE
101
175
my $size = -s $file;
102
176
return undef if ($size < 32); #File to small..
103
177
104
178
my ($bs) = undef;
105
179
seek(PCM, 24,0);
106
180
read(PCM, $bs, 4);
107
181
my $srate = GNUpod::FooBar::shx2int($bs);
108
182
109
seek(PCM, 28,0);
183
seek(PCM, 28,0);
110
184
read(PCM, $bs, 4);
111
185
my $bps = GNUpod::FooBar::shx2int($bs);
112
186
118
192
return undef;
119
193
}
120
194
121
#fixme
122
warn "FileMagic: debug: bps -> *$bps* / srate -> *$srate*\n";
195
123
196
my %rh = ();
124
197
$rh{bitrate} = $bps;
125
198
$rh{filesize} = $size;
126
199
$rh{srate} = $srate;
127
200
$rh{time} = int(1000*$size/$bps);
128
201
$rh{fdesc} = "RIFF Audio File";
129
130
202
#No id3 tags for us.. but mmmmaybe...
131
#We use getuft8 because you could use umlauts and such things :)
203
#We use getuft8 because you could use umlauts and such things :)
204
#Fixme: absolute versus relative paths :
132
205
$rh{title} = getutf8(((split(/\//, $file))[-1]) || "Unknown Title");
133
206
$rh{album} = getutf8(((split(/\//, $file))[-2]) || "Unknown Album");
134
207
$rh{artist} = getutf8(((split(/\//, $file))[-3]) || "Unknown Artist");
140
213
######################################################################
141
214
# Read mp3 tags, return undef if file is not an mp3
142
215
sub __is_mp3 {
143
my($file, %opts) = @_;
144
216
my($file,$flags) = @_;
217
145
218
my $h = MP3::Info::get_mp3info($file);
146
219
return undef unless $h; #No mp3
147
220
148
221
#This is our default fallback:
149
222
#If we didn't find a title, we'll use the
150
223
#Filename.. why? because you are not able
151
224
#to play the file without an filename ;)
152
225
my $cf = ((split(/\//,$file))[-1]);
153
154
155
# If we restore, don't use the leadings digits
156
# in the fallback title
157
if ($opts{restore}) { $cf =~ s/^[0-9]*_//; }
158
226
159
227
my %rh = ();
160
228
161
229
$rh{bitrate} = $h->{BITRATE};
163
231
$rh{srate} = int($h->{FREQUENCY}*1000);
164
232
$rh{time} = int($h->{SECS}*1000);
165
233
$rh{fdesc} = "MPEG ${$h}{VERSION} layer ${$h}{LAYER} file";
166
my $h = MP3::Info::get_mp3tag($file,1); #Get the IDv1 tag
167
my $hs = MP3::Info::get_mp3tag($file, 2,1); #Get the IDv2 tag
234
235
my $h =undef;
236
my $hs=undef;
237
238
$h = MP3::Info::get_mp3tag($file,1) unless $flags->{'noIDv1'}; #Get the IDv1 tag
239
$hs = MP3::Info::get_mp3tag($file, 2,1) unless $flags->{'noIDv2'}; #Get the IDv2 tag
240
241
242
#The IDv2 Hashref may return arrays.. kill them :)
243
foreach my $xkey (keys(%$hs)) {
244
if( ref($hs->{$xkey}) eq "ARRAY" ) {
245
$hs->{$xkey} = join(":", @{$hs->{$xkey}});
246
}
247
}
168
248
169
249
170
250
#IDv2 is stronger than IDv1..
171
251
#Try to parse things like 01/01
172
my @songa = pss(getutf8($hs->{TRCK} || $h->{TRACKNUM}));
252
my @songa = pss(getutf8($hs->{TRCK} || $hs->{TRK} || $h->{TRACKNUM}));
173
253
my @cda = pss(getutf8($hs->{TPOS}));
174
254
175
255
$rh{songs} = int($songa[1]);
176
256
$rh{songnum} = int($songa[0]);
177
257
$rh{cdnum} = int($cda[0]);
178
258
$rh{cds} = int($cda[1]);
179
$rh{year} = getutf8($hs->{TYER} || $h->{YEAR} || 0);
180
$rh{title} = getutf8($hs->{TIT2} || $h->{TITLE} || $cf || "Untitled");
181
$rh{album} = getutf8($hs->{TALB} || $h->{ALBUM} || "Unknown Album");
182
$rh{artist} = getutf8($hs->{TPE1} || $h->{ARTIST} || "Unknown Artist");
183
$rh{genre} = getutf8( $h->{GENRE} || "");
184
$rh{comment} = getutf8($hs->{COMM} || $h->{COMMENT} || "");
185
$rh{composer} = getutf8($hs->{TCOM} || "");
186
$rh{playcount}= int(getutf8($hs->{PCNT})) || 0;
187
259
$rh{year} = getutf8($hs->{TYER} || $hs->{TYE} || $h->{YEAR} || 0);
260
$rh{title} = getutf8($hs->{TIT2} || $hs->{TT2} || $h->{TITLE} || $cf || "Untitled");
261
$rh{album} = getutf8($hs->{TALB} || $hs->{TAL} || $h->{ALBUM} || "Unknown Album");
262
$rh{artist} = getutf8($hs->{TPE1} || $hs->{TP1} || $h->{ARTIST} || "Unknown Artist");
263
$rh{genre} = _get_genre( getutf8($hs->{TCON} || $hs->{TCO} || $h->{GENRE} || "") );
264
$rh{comment} = getutf8($hs->{COMM} || $hs->{COM} || $h->{COMMENT} || "");
265
$rh{composer} = getutf8($hs->{TCOM} || $hs->{TCM} || "");
266
$rh{playcount}= int(getutf8($hs->{PCNT} || $hs->{CNT})) || 0;
267
$rh{soundcheck} = _parse_iTunNORM(getutf8($hs->{COMM} || $hs->{COM} || $h->{COMMENT}));
188
268
return \%rh;
189
269
}
190
270
271
########
272
# Guess a genre
273
sub _get_genre {
274
my ($string) = @_;
275
my $num_to_txt = undef;
276
277
if($string =~ /^\((\d+)\)$/) {
278
$num_to_txt = $mp3_genres[$1];
279
}
280
return ($num_to_txt || $string);
281
}
191
282
192
283
########
193
284
# Guess format
206
297
sub getutf8 {
207
298
my($in) = @_;
208
299
300
return undef unless $in; #Do not fsckup empty input
301
302
#Get the ENCODING
209
303
$in =~ s/^(.)//;
210
304
my $encoding = $1;
211
305
212
if(ord($encoding) > 0 && ord($encoding) < 32) {
306
# -> UTF16 with or without BOM
307
if(ord($encoding) == 1 || ord($encoding) == 2) {
308
my $bfx = Unicode::String::utf16($in); #Object is utf16
309
$bfx->byteswap if $bfx->ord == 0xFFFE;
310
$in = $bfx->utf16; #Return utf16 version
311
}
312
# -> UTF8
313
elsif(ord($encoding) == 3) {
314
my $bfx = Unicode::String::utf8($in)->utf8; #Paranoia
315
$in = $bfx;
316
}
317
# -> INVALID
318
elsif(ord($encoding) > 0 && ord($encoding) < 32) {
213
319
warn "FileMagic.pm: warning: unsupportet ID3 Encoding found: ".ord($encoding)."\n";
214
320
warn " send a bugreport to pab\@blinkenlights.ch\n";
215
321
return undef;
216
322
}
217
else { #AutoGuess (We accept invalid id3tags)
323
# -> 0 or nothing
324
else {
218
325
$in = $encoding.$in;
219
326
#Remove all 00's
220
327
$in =~ tr/\0//d;
234
341
return $in;
235
342
}
236
343
344
##############################
345
# Parse iTunNORM string
346
# FIXME: result isn't the same as iTunes sometimes..
347
sub _parse_iTunNORM {
348
my($string) = @_;
349
if($string =~ /^(engiTunNORM\s|\s)(\S{8})\s(\S{8})\s/) {
350
return oct("0x".$3);
351
}
352
return undef;
353
354
}
355
356
#########################################################
357
# Start the converter
358
sub kick_convert {
359
my($prog, $file, $format, $con) = @_;
360
361
$prog = "$con->{bindir}/$prog";
362
363
open(KICKOMATIC, "-|") or exec($prog, $file, "GET_$format") or die "FileMagic::kick_convert: Could not exec $prog\n";
364
my $newP = <KICKOMATIC>;
365
chomp($newP);
366
close(KICKOMATIC);
367
368
if($newP =~ /^PATH:(.+)$/) {
369
return $1;
370
}
371
return undef;
372
}
373
374
375
#########################################################
376
# Read metadata from converter
377
sub converter_readmeta {
378
my($prog, $file, $con) = @_;
379
380
$prog = "$con->{bindir}/$prog";
381
382
383
my %metastuff = ();
384
open(CFLAC, "-|") or exec($prog, $file, "GET_META") or die "converter_readmeta: Could not exec $prog\n";
385
while(<CFLAC>) {
386
chomp($_);
387
if($_ =~ /^([^:]+):(.*)$/) {
388
$metastuff{$1} = $2;
389
}
390
}
391
close(CFLAC);
392
return undef unless $metastuff{FORMAT};
393
return \%metastuff;
394
}
395
237
396
1;
397
Loggerhead is a web-based interface for Breezy
Version: 2.0.1