root/lang/perl/tiarra/trunk/module/Tools/ID3Tag.pm @ 15704

Revision 15704, 4.0 kB (checked in by hio, 6 years ago)

Tools::ID3Tag, MP3のID3タグの簡易抽出.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Date Revision Author HeadURL Id
Line 
1## ----------------------------------------------------------------------------
2#  Tools::ID3Tag.
3# -----------------------------------------------------------------------------
4# Mastering programmed by YAMASHINA Hio
5#
6# Copyright 2008 YAMASHINA Hio
7# -----------------------------------------------------------------------------
8# $Id$
9# -----------------------------------------------------------------------------
10package Tools::ID3Tag;
11use strict;
12use warnings;
13use Unicode::Japanese;
14
15our $VERSION = '0.01';
16
171;
18
19# -----------------------------------------------------------------------------
20# $info = $pkg->extract($content).
21# $info->{version} = "2.x.x";
22# $info->{title}   = $title  | undef;
23# $info->{artist}  = $artist | undef;
24# $info->{album}   = $album  | undef;
25#
26sub extract
27{
28  my $pkg     = shift;
29  my $content = shift;
30
31  if( $content !~ m{^ID3(.{7})}s )
32  {
33    return;
34  }
35
36  # ID3v2 tag.
37  my ($major, $minor, $flags, $size) = unpack("CCCN", $1);
38  my $ver = "2.$major.$minor";
39  my $is_unsync       = $flags & (1 << 7);
40  my $has_ex_header   = ($flags & (1 << 6)) && ($major >= 3);
41  my $has_expermental = $flags & (1 << 5);
42  my $has_footer      = $flags & (1 << 4);
43  #$DEBUG and print "id3v2: version=$ver, flags=".(sprintf("%x",$flags)).", ex=".($has_ex_header?"yes":"no").", footer=".($has_footer?"yes":"no")."\n";
44
45  if( $size < length($content) )
46  {
47    $content = substr($content, 0, $size);
48  }
49
50  my $offset = 10;
51  my $info = {
52    version => $ver,
53    size    => $size,
54    title   => undef,
55    artist  => undef,
56    album   => undef,
57  };
58  my $old_frameid = {
59    TT2 => 'TIT2',
60    TP1 => 'TPE1',
61    TAL => 'TALB',
62  };
63
64  if( $has_ex_header )
65  {
66    my $ex_size = unpack("\@$offset N", $content);
67    if( !$ex_size || $ex_size <= 6 || $offset + $ex_size > length($content) )
68    {
69      return;
70    }
71    #my $ex = substr($content, $offset, $size);
72    $offset += $size;
73  }
74
75  # frames.
76  for(;;)
77  {
78    my ($id, $size, $flags);
79    my ($hsize, $hformat);
80    if( $major == 2 )
81    {
82      # 2.2.x
83      if( $offset + 6 > length($content) )
84      {
85        last;
86      }
87      ($id, $size) = unpack("\@$offset a3 a3", $content);
88      $id    = $old_frameid->{$id} || $id;
89      $size  = unpack("N", "\0".$size);
90      $flags = 0;
91      $offset += 6;
92    }else
93    {
94      # 2.3.x-
95      if( $offset + 10 > length($content) )
96      {
97        last;
98      }
99      ($id, $size, $flags) = unpack("\@$offset a4 N n", $content);
100      $offset += 10;
101    }
102    if( $offset + $size > length($content) )
103    {
104      # over flow.
105      last;
106    }
107    my $pack = substr($content, $offset, $size);
108    $offset += $size;
109
110    if( $id eq 'TIT2' )
111    {
112      $info->{title} = $pkg->_decode_text_normal($pack);
113    }
114    if( $id eq 'TPE1' )
115    {
116      $info->{artist} = $pkg->_decode_text_normal($pack);
117    }
118    if( $id eq 'TALB' )
119    {
120      $info->{album} = $pkg->_decode_text_normal($pack);
121    }
122  }
123  $info;
124}
125
126sub _decode_text_normal
127{
128  my $pkg  = shift;
129  my $pack = shift;
130
131  defined($pack) && length($pack)>=1 or die "#_decode_text_normal, no input";
132
133  my $type = unpack("C", substr($pack, 0, 1, ''));
134  my $out;
135  if( $type == 0 )
136  {
137    # local encoding.
138    $out = Unicode::Japanese->new($pack, 'auto')->utf8;
139  }elsif( $type == 1 )
140  {
141    # UTF-16 (with-BOM)
142    $out = Unicode::Japanese->new($pack, 'auto')->utf8;
143  }elsif( $type == 2 )
144  {
145    # UTF-16BE (without-BOM)
146    $out = Unicode::Japanese->new($pack, 'utf16be')->utf8;
147  }elsif( $type == 3 )
148  {
149    # UTF-8
150    $out = $pack;
151  }else
152  {
153    die "#_decode_text_normal, unsupported type: $type";
154  }
155  $out =~ s/\0+\z//;
156  $out;
157}
158
159
160# -----------------------------------------------------------------------------
161# End of Module.
162# -----------------------------------------------------------------------------
163# -----------------------------------------------------------------------------
164# End of File.
165# -----------------------------------------------------------------------------
166__END__
167
168=encoding utf8
169
170=for stopwords
171        YAMASHINA
172        Hio
173        ACKNOWLEDGEMENTS
174        AnnoCPAN
175        CPAN
176        RT
177
Note: See TracBrowser for help on using the browser.