| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Audio::M4P::QuickTime; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | require 5.008; | 
| 4 | 6 |  |  | 6 |  | 116508 | use strict; | 
|  | 6 |  |  |  |  | 13 |  | 
|  | 6 |  |  |  |  | 221 |  | 
| 5 | 6 |  |  | 6 |  | 34 | use warnings; | 
|  | 6 |  |  |  |  | 11 |  | 
|  | 6 |  |  |  |  | 174 |  | 
| 6 | 6 |  |  | 6 |  | 33 | use Carp; | 
|  | 6 |  |  |  |  | 12 |  | 
|  | 6 |  |  |  |  | 683 |  | 
| 7 | 6 |  |  | 6 |  | 34 | use Scalar::Util 'weaken'; | 
|  | 6 |  |  |  |  | 11 |  | 
|  | 6 |  |  |  |  | 1023 |  | 
| 8 |  |  |  |  |  |  | our $VERSION = '0.55'; | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 6 |  |  | 6 |  | 3970 | use Audio::M4P::Atom; | 
|  | 6 |  |  |  |  | 21 |  | 
|  | 6 |  |  |  |  | 77713 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | #-------------- useful hashes and arrays ------------------------------------# | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | our %meta_info_types = ( | 
| 15 |  |  |  |  |  |  | aART   => 1,   # album artist | 
| 16 |  |  |  |  |  |  | aaid   => 1,   # album artist | 
| 17 |  |  |  |  |  |  | '©alb' => 1,   # album | 
| 18 |  |  |  |  |  |  | akid   => 1,   # ? alternate id ? | 
| 19 |  |  |  |  |  |  | apid   => 1,   # apple id | 
| 20 |  |  |  |  |  |  | '©ART' => 1,   # artist (performing) | 
| 21 |  |  |  |  |  |  | atid   => 1,   # apple itunes id ? | 
| 22 |  |  |  |  |  |  | catg   => 1,   # category | 
| 23 |  |  |  |  |  |  | '©cmt' => 1,   # comment field | 
| 24 |  |  |  |  |  |  | '©com' => 1,   # composer | 
| 25 |  |  |  |  |  |  | covr   => 1,   # cover art | 
| 26 |  |  |  |  |  |  | cpil   => 1,   # 1 if compilation => 0 if not ? | 
| 27 |  |  |  |  |  |  | cprt   => 1,   # copyrighted material purchaser ? | 
| 28 |  |  |  |  |  |  | '©day' => 1,   # date of release--often just the year | 
| 29 |  |  |  |  |  |  | disk   => 1,   # CD set number: cut is from, disk [field 1] of [field 2] | 
| 30 |  |  |  |  |  |  | geid   => 1,   # iTMS store ID ? | 
| 31 |  |  |  |  |  |  | gnre   => 1,   # genre | 
| 32 |  |  |  |  |  |  | '©grp' => 1,   # group(?) | 
| 33 |  |  |  |  |  |  | '©lyr' => 1,   # lyrics | 
| 34 |  |  |  |  |  |  | '©nam' => 1,   # title of track | 
| 35 |  |  |  |  |  |  | pcst   => 1,   # podcast flag | 
| 36 |  |  |  |  |  |  | pgap   => 1,   # iTunes gapless playback ? | 
| 37 |  |  |  |  |  |  | pinf   => 1,   # iTunes 7.2+ purchaser info ? | 
| 38 |  |  |  |  |  |  | plid   => 1,   # purchase id ? | 
| 39 |  |  |  |  |  |  | purd   => 1,   # iTunes 6+ purchase date | 
| 40 |  |  |  |  |  |  | purl   => 1,   # program URL | 
| 41 |  |  |  |  |  |  | rtng   => 1,   # rating (integer) | 
| 42 |  |  |  |  |  |  | sfid   => 1,   # ? itms ID info | 
| 43 |  |  |  |  |  |  | sign   => 1,   # ? file hash signature | 
| 44 |  |  |  |  |  |  | stik   => 1,   # movie type: 0x1 default, 0x5 bookmarkable, 0x6 music video, | 
| 45 |  |  |  |  |  |  | # 0xA TV show, ?? 0x2 newsreel, 0xE ringtone | 
| 46 |  |  |  |  |  |  | tmpo   => 1,   # tempo (beats per minute) | 
| 47 |  |  |  |  |  |  | '©too' => 1,   # encoder | 
| 48 |  |  |  |  |  |  | trkn   => 1,   # two fields: [field 1] track num. of [field 2] total tracks | 
| 49 |  |  |  |  |  |  | tves   => 1,   # TV show episode | 
| 50 |  |  |  |  |  |  | tvsh   => 1,   # TV show | 
| 51 |  |  |  |  |  |  | '©wrt' => 1,   # composer | 
| 52 |  |  |  |  |  |  | '----' => 1,   # itunes specific info | 
| 53 |  |  |  |  |  |  | ); | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | our %utf8_atoms = ( | 
| 56 |  |  |  |  |  |  | aART   => 1,    # album artist | 
| 57 |  |  |  |  |  |  | aaid   => 1,    # album artist | 
| 58 |  |  |  |  |  |  | '©alb' => 1,    # album | 
| 59 |  |  |  |  |  |  | '©ART' => 1,    # artist (performing) | 
| 60 |  |  |  |  |  |  | catg   => 1,    # category | 
| 61 |  |  |  |  |  |  | '©cmt' => 1,    # comment field | 
| 62 |  |  |  |  |  |  | '©com' => 1,    # composer | 
| 63 |  |  |  |  |  |  | cprt   => 1,    # copyrighted material purchaser ? | 
| 64 |  |  |  |  |  |  | '©day' => 1,    # date of release--often just the year | 
| 65 |  |  |  |  |  |  | '©grp' => 1,    # group(?) | 
| 66 |  |  |  |  |  |  | '©lyr' => 1,    # lyrics | 
| 67 |  |  |  |  |  |  | '©nam' => 1,    # title of track | 
| 68 |  |  |  |  |  |  | purl   => 1,    # program URL | 
| 69 |  |  |  |  |  |  | '©too' => 1,    # encoder | 
| 70 |  |  |  |  |  |  | tves   => 1,    # TV show episode | 
| 71 |  |  |  |  |  |  | tvsh   => 1,    # TV show | 
| 72 |  |  |  |  |  |  | '©wrt' => 1,    # composer | 
| 73 |  |  |  |  |  |  | ); | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | our %tag_types = ( | 
| 76 |  |  |  |  |  |  | AAID     => 'aaid', | 
| 77 |  |  |  |  |  |  | AAID     => 'aART', | 
| 78 |  |  |  |  |  |  | ALB      => '©alb', | 
| 79 |  |  |  |  |  |  | ALBUM    => '©alb', | 
| 80 |  |  |  |  |  |  | ARTIST   => '©ART', | 
| 81 |  |  |  |  |  |  | CMT      => '©cmt', | 
| 82 |  |  |  |  |  |  | COMMENT  => '©cmt', | 
| 83 |  |  |  |  |  |  | COM      => '©com', | 
| 84 |  |  |  |  |  |  | CPIL     => 'cpil', | 
| 85 |  |  |  |  |  |  | CPRT     => 'cprt', | 
| 86 |  |  |  |  |  |  | DAY      => '©day', | 
| 87 |  |  |  |  |  |  | DISK     => 'disk', | 
| 88 |  |  |  |  |  |  | GENRE    => 'gnre', | 
| 89 |  |  |  |  |  |  | GNRE     => 'gnre', | 
| 90 |  |  |  |  |  |  | GRP      => '©grp', | 
| 91 |  |  |  |  |  |  | NAM      => '©nam', | 
| 92 |  |  |  |  |  |  | RTNG     => 'rtng', | 
| 93 |  |  |  |  |  |  | SONG     => '©nam', | 
| 94 |  |  |  |  |  |  | TITLE    => '©nam', | 
| 95 |  |  |  |  |  |  | TMPO     => 'tmpo', | 
| 96 |  |  |  |  |  |  | TOO      => '©too', | 
| 97 |  |  |  |  |  |  | TRACKNUM => 'trkn', | 
| 98 |  |  |  |  |  |  | TRKN     => 'trkn', | 
| 99 |  |  |  |  |  |  | WRT      => '©wrt', | 
| 100 |  |  |  |  |  |  | COVR     => 'covr', | 
| 101 |  |  |  |  |  |  | LYRICS   => '©lyr', | 
| 102 |  |  |  |  |  |  | GENRE_   => '©gen', | 
| 103 |  |  |  |  |  |  | YEAR     => '©day', | 
| 104 |  |  |  |  |  |  | ); | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | our %alternate_tag_types = ( | 
| 107 |  |  |  |  |  |  | GENRE   => 'GNRE', | 
| 108 |  |  |  |  |  |  | NAM     => 'TITLE', | 
| 109 |  |  |  |  |  |  | ARTIST  => 'ART', | 
| 110 |  |  |  |  |  |  | ALBUM   => 'ALB', | 
| 111 |  |  |  |  |  |  | YEAR    => 'DAY', | 
| 112 |  |  |  |  |  |  | COMMENT => 'CMT', | 
| 113 |  |  |  |  |  |  | TRKN    => 'TRACKNUM', | 
| 114 |  |  |  |  |  |  | SONG    => 'TITLE', | 
| 115 |  |  |  |  |  |  | ); | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | our @m4p_not_m4a_atom_types = qw( sinf cnID apID atID plID geID akID ---- ); | 
| 118 |  |  |  |  |  |  | our @apple_user_id_atoms = qw( pinf apID cnID atID plID geID sfID akID purd ); | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | our %iTMS_dict_meta_types = ( | 
| 121 |  |  |  |  |  |  | copyright          => 'cprt', | 
| 122 |  |  |  |  |  |  | comments           => '©cmt', | 
| 123 |  |  |  |  |  |  | songName           => '©nam', | 
| 124 |  |  |  |  |  |  | genre              => 'gnre', | 
| 125 |  |  |  |  |  |  | playlistArtistName => '©ART', | 
| 126 |  |  |  |  |  |  | genreID            => '©gen', | 
| 127 |  |  |  |  |  |  | composerName       => '©wrt', | 
| 128 |  |  |  |  |  |  | playlistName       => '©alb', | 
| 129 |  |  |  |  |  |  | year               => '©day', | 
| 130 |  |  |  |  |  |  | trackNumber        => 'trkn', | 
| 131 |  |  |  |  |  |  | trackCount         => 'trkn', | 
| 132 |  |  |  |  |  |  | discNumber         => 'disk', | 
| 133 |  |  |  |  |  |  | discCount          => 'disk', | 
| 134 |  |  |  |  |  |  | artworkURL         => 'covr', | 
| 135 |  |  |  |  |  |  | ); | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | our @genre_strings = ( | 
| 138 |  |  |  |  |  |  | "Blues",             "Classic Rock", | 
| 139 |  |  |  |  |  |  | "Country",           "Dance", | 
| 140 |  |  |  |  |  |  | "Disco",             "Funk", | 
| 141 |  |  |  |  |  |  | "Grunge",            "Hip-Hop", | 
| 142 |  |  |  |  |  |  | "Jazz",              "Metal", | 
| 143 |  |  |  |  |  |  | "New Age",           "Oldies", | 
| 144 |  |  |  |  |  |  | "Other",             "Pop", | 
| 145 |  |  |  |  |  |  | "R&B",               "Rap", | 
| 146 |  |  |  |  |  |  | "Reggae",            "Rock", | 
| 147 |  |  |  |  |  |  | "Techno",            "Industrial", | 
| 148 |  |  |  |  |  |  | "Alternative",       "Ska", | 
| 149 |  |  |  |  |  |  | "Death Metal",       "Pranks", | 
| 150 |  |  |  |  |  |  | "Soundtrack",        "Euro-Techno", | 
| 151 |  |  |  |  |  |  | "Ambient",           "Trip-Hop", | 
| 152 |  |  |  |  |  |  | "Vocal",             "Jazz+Funk", | 
| 153 |  |  |  |  |  |  | "Fusion",            "Trance", | 
| 154 |  |  |  |  |  |  | "Classical",         "Instrumental", | 
| 155 |  |  |  |  |  |  | "Acid",              "House", | 
| 156 |  |  |  |  |  |  | "Game",              "Sound Clip", | 
| 157 |  |  |  |  |  |  | "Gospel",            "Noise", | 
| 158 |  |  |  |  |  |  | "AlternRock",        "Bass", | 
| 159 |  |  |  |  |  |  | "Soul",              "Punk", | 
| 160 |  |  |  |  |  |  | "Space",             "Meditative", | 
| 161 |  |  |  |  |  |  | "Instrumental Pop",  "Instrumental Rock", | 
| 162 |  |  |  |  |  |  | "Ethnic",            "Gothic", | 
| 163 |  |  |  |  |  |  | "Darkwave",          "Techno-Industrial", | 
| 164 |  |  |  |  |  |  | "Electronic",        "Pop-Folk", | 
| 165 |  |  |  |  |  |  | "Eurodance",         "Dream", | 
| 166 |  |  |  |  |  |  | "Southern Rock",     "Comedy", | 
| 167 |  |  |  |  |  |  | "Cult",              "Gangsta", | 
| 168 |  |  |  |  |  |  | "Top 40",            "Christian Rap", | 
| 169 |  |  |  |  |  |  | "Pop/Funk",          "Jungle", | 
| 170 |  |  |  |  |  |  | "Native American",   "Cabaret", | 
| 171 |  |  |  |  |  |  | "New Wave",          "Psychadelic", | 
| 172 |  |  |  |  |  |  | "Rave",              "Showtunes", | 
| 173 |  |  |  |  |  |  | "Trailer",           "Lo-Fi", | 
| 174 |  |  |  |  |  |  | "Tribal",            "Acid Punk", | 
| 175 |  |  |  |  |  |  | "Acid Jazz",         "Polka", | 
| 176 |  |  |  |  |  |  | "Retro",             "Musical", | 
| 177 |  |  |  |  |  |  | "Rock & Roll",       "Hard Rock", | 
| 178 |  |  |  |  |  |  | "Folk",              "Folk/Rock", | 
| 179 |  |  |  |  |  |  | "National Folk",     "Swing", | 
| 180 |  |  |  |  |  |  | "Fast-Fusion",       "BeBop", | 
| 181 |  |  |  |  |  |  | "Latin",             "Revival", | 
| 182 |  |  |  |  |  |  | "Celtic",            "Bluegrass", | 
| 183 |  |  |  |  |  |  | "Avantgarde",        "Gothic Rock", | 
| 184 |  |  |  |  |  |  | "Progressive Rock",  "Psychedelic Rock", | 
| 185 |  |  |  |  |  |  | "Symphonic Rock",    "Slow Rock", | 
| 186 |  |  |  |  |  |  | "Big Band",          "Chorus", | 
| 187 |  |  |  |  |  |  | "Easy Listening",    "Acoustic", | 
| 188 |  |  |  |  |  |  | "Humour",            "Speech", | 
| 189 |  |  |  |  |  |  | "Chanson",           "Opera", | 
| 190 |  |  |  |  |  |  | "Chamber Music",     "Sonata", | 
| 191 |  |  |  |  |  |  | "Symphony",          "Booty Bass", | 
| 192 |  |  |  |  |  |  | "Primus",            "Porn Groove", | 
| 193 |  |  |  |  |  |  | "Satire",            "Slow Jam", | 
| 194 |  |  |  |  |  |  | "Club",              "Tango", | 
| 195 |  |  |  |  |  |  | "Samba",             "Folklore", | 
| 196 |  |  |  |  |  |  | "Ballad",            "Power Ballad", | 
| 197 |  |  |  |  |  |  | "Rhythmic Soul",     "Freestyle", | 
| 198 |  |  |  |  |  |  | "Duet",              "Punk Rock", | 
| 199 |  |  |  |  |  |  | "Drum Solo",         "A capella", | 
| 200 |  |  |  |  |  |  | "Euro-House",        "Dance Hall", | 
| 201 |  |  |  |  |  |  | "Goa",               "Drum & Bass", | 
| 202 |  |  |  |  |  |  | "Club House",        "Hardcore", | 
| 203 |  |  |  |  |  |  | "Terror",            "Indie", | 
| 204 |  |  |  |  |  |  | "BritPop",           "NegerPunk", | 
| 205 |  |  |  |  |  |  | "Polsk Punk",        "Beat", | 
| 206 |  |  |  |  |  |  | "Christian Gangsta", "Heavy Metal", | 
| 207 |  |  |  |  |  |  | "Black Metal",       "Crossover", | 
| 208 |  |  |  |  |  |  | "Contemporary C",    "Christian Rock", | 
| 209 |  |  |  |  |  |  | "Merengue",          "Salsa", | 
| 210 |  |  |  |  |  |  | "Thrash Metal",      "Anime", | 
| 211 |  |  |  |  |  |  | "JPop",              "SynthPop", | 
| 212 |  |  |  |  |  |  | "INVALID_GENRE" | 
| 213 |  |  |  |  |  |  | ); | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | our %genre_text_to_genre_numbers; | 
| 216 |  |  |  |  |  |  | my $genre_num = 1; | 
| 217 |  |  |  |  |  |  | foreach my $genre (@genre_strings) { | 
| 218 |  |  |  |  |  |  | $genre_text_to_genre_numbers{$genre} = $genre_num; | 
| 219 |  |  |  |  |  |  | ++$genre_num; | 
| 220 |  |  |  |  |  |  | } | 
| 221 |  |  |  |  |  |  | our %genre_numbers_to_genre_text = reverse %genre_text_to_genre_numbers; | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | our %asset_3GP_types = ( | 
| 224 |  |  |  |  |  |  | ALBUM     => 'albm',    # album title and track number for the media | 
| 225 |  |  |  |  |  |  | ARTIST    => 'perf',    # performer or artist | 
| 226 |  |  |  |  |  |  | COM       => 'auth',    # author/composer of the media | 
| 227 |  |  |  |  |  |  | COMMENT   => 'dscp',    # caption or description for the media | 
| 228 |  |  |  |  |  |  | COPYRIGHT => 'cprt',    # notice about organisation holding copyright | 
| 229 |  |  |  |  |  |  | GENRE     => 'gnre',    # genre (category and style) of the media | 
| 230 |  |  |  |  |  |  | RTNG      => 'rtng',    # media rating | 
| 231 |  |  |  |  |  |  | TITLE     => 'titl',    # title for the media | 
| 232 |  |  |  |  |  |  | YEAR      => 'yrrc',    # recording year for the media | 
| 233 |  |  |  |  |  |  |  | 
| 234 |  |  |  |  |  |  | # these exist in 3GP but not really in iTMS meta data | 
| 235 |  |  |  |  |  |  | CLASS    => 'clsf',     # classification of the media | 
| 236 |  |  |  |  |  |  | KEYWORDS => 'kywd',     # media keywords | 
| 237 |  |  |  |  |  |  | LOCATION => 'loci',     # location information | 
| 238 |  |  |  |  |  |  | ); | 
| 239 |  |  |  |  |  |  |  | 
| 240 |  |  |  |  |  |  | our $default_asset_3GP_lang = 'eng'; | 
| 241 |  |  |  |  |  |  |  | 
| 242 |  |  |  |  |  |  | #------------------- object methods -----------------------------------------# | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | sub new { | 
| 245 | 18 |  |  | 18 | 1 | 4013 | my ( $class, %args ) = @_; | 
| 246 | 18 |  |  |  |  | 47 | my $self = {}; | 
| 247 | 18 |  |  |  |  | 56 | bless( $self, $class ); | 
| 248 | 18 |  |  |  |  | 368 | $self->{meta} = {}; | 
| 249 | 18 |  |  |  |  | 55 | foreach my $k (qw( DEBUG DEBUGDUMPFILE file)) { | 
| 250 | 54 | 100 |  |  |  | 320 | $self->{$k} = $args{$k} if exists $args{$k}; | 
| 251 |  |  |  |  |  |  | } | 
| 252 | 18 | 50 |  |  |  | 91 | $self->{DEBUG} = 0 unless exists $self->{DEBUG}; | 
| 253 | 18 | 100 |  |  |  | 71 | if ( exists $self->{file} ) { | 
| 254 | 15 |  |  |  |  | 76 | $self->ReadFile( $self->{file} ); | 
| 255 | 15 |  |  |  |  | 74 | $self->ParseBuffer(); | 
| 256 |  |  |  |  |  |  | } | 
| 257 | 18 |  |  |  |  | 134 | return $self; | 
| 258 |  |  |  |  |  |  | } | 
| 259 |  |  |  |  |  |  |  | 
| 260 |  |  |  |  |  |  | sub DESTROY { | 
| 261 | 18 |  |  | 18 |  | 1715 | my($self) = @_; | 
| 262 | 18 | 100 |  |  |  | 457 | if( ref $self->{root} ) { | 
| 263 | 15 |  |  |  |  | 79 | $self->{root}->DESTROY; | 
| 264 |  |  |  |  |  |  | } | 
| 265 |  |  |  |  |  |  | } | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | sub ReadFile { | 
| 268 | 15 |  |  | 15 | 1 | 34 | my ( $self, $infile ) = @_; | 
| 269 | 15 | 50 |  |  |  | 922 | open( my $infh, '<', $infile ) or croak "Cannot open input $infile: $!"; | 
| 270 | 15 |  |  |  |  | 50 | binmode $infh; | 
| 271 | 15 | 50 |  |  |  | 13939 | read( $infh, $self->{buffer}, -s $infile ) or croak "Bad file read: $!"; | 
| 272 | 15 |  |  |  |  | 424 | close $infh; | 
| 273 | 15 |  |  |  |  | 148 | $self->{meta}->{filesize} = length $self->{buffer}; | 
| 274 |  |  |  |  |  |  | } | 
| 275 |  |  |  |  |  |  |  | 
| 276 |  |  |  |  |  |  | sub ParseBuffer { | 
| 277 | 15 |  |  | 15 | 1 | 40 | my ($self) = @_; | 
| 278 | 15 |  |  |  |  | 44 | $self->{atom_count} = 0; | 
| 279 | 15 |  |  |  |  | 178 | $self->{root}       = new Audio::M4P::Atom( | 
| 280 |  |  |  |  |  |  | rbuf                  => \$self->{buffer}, | 
| 281 |  |  |  |  |  |  | type                  => 'file', | 
| 282 |  |  |  |  |  |  | size                  => length $self->{buffer}, | 
| 283 |  |  |  |  |  |  | read_buffer_position  => 0, | 
| 284 |  |  |  |  |  |  | offset                => 8, | 
| 285 |  |  |  |  |  |  | parent                => 0, | 
| 286 |  |  |  |  |  |  | ); | 
| 287 | 15 |  |  |  |  | 63 | weaken $self->{root}; | 
| 288 | 15 |  |  |  |  | 32 | my $fsize = length $self->{buffer}; | 
| 289 | 15 | 50 |  |  |  | 342 | print "Buffer size is $fsize\n" if $self->{DEBUG}; | 
| 290 | 15 |  |  |  |  | 76 | $self->ParseMP4Container( $self->{root}->node, 0, $fsize ); | 
| 291 | 15 | 50 |  |  |  | 79 | print "Found $self->{atom_count} atoms.\n" if $self->{DEBUG}; | 
| 292 | 15 | 50 |  |  |  | 69 | $self->DumpTree( $self->{DEBUGDUMPFILE} )  if $self->{DEBUG} > 1; | 
| 293 |  |  |  |  |  |  | } | 
| 294 |  |  |  |  |  |  |  | 
| 295 |  |  |  |  |  |  | sub WriteFile { | 
| 296 | 9 |  |  | 9 | 1 | 56 | my ( $self, $outfile ) = @_; | 
| 297 | 9 | 50 |  |  |  | 39046 | open( my $outfh, '>', $outfile ) or croak "Cannot open output $outfile: $!"; | 
| 298 | 9 |  |  |  |  | 43 | binmode $outfh; | 
| 299 | 9 |  |  |  |  | 16300 | my $retval = print $outfh $self->{buffer}; | 
| 300 | 9 |  |  |  |  | 361 | close $outfh; | 
| 301 | 9 |  |  |  |  | 115 | return $retval; | 
| 302 |  |  |  |  |  |  | } | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | sub ParseMP4Container { | 
| 305 | 422 |  |  | 422 | 1 | 646 | my ( $self, $parent, $posit, $end_posit ) = @_; | 
| 306 | 422 | 50 |  |  |  | 1021 | my $pAtom = $parent->getNodeValue() or croak "Cannot get atom from node"; | 
| 307 | 422 | 50 |  |  |  | 2182 | $posit     = $pAtom->start + $pAtom->offset unless defined $posit; | 
| 308 | 422 | 50 |  |  |  | 743 | $end_posit = $pAtom->start + $pAtom->size   unless $end_posit; | 
| 309 | 422 |  |  |  |  | 849 | while ( $posit < $end_posit ) { | 
| 310 | 1113 |  |  |  |  | 3855 | my $atom = new Audio::M4P::Atom( | 
| 311 |  |  |  |  |  |  | parent               => $parent, | 
| 312 |  |  |  |  |  |  | rbuf                 => \$self->{buffer}, | 
| 313 |  |  |  |  |  |  | read_buffer_position => $posit | 
| 314 |  |  |  |  |  |  | ); | 
| 315 | 1113 | 50 |  |  |  | 7025 | print $atom->type, " at $posit size ", $atom->size, "\n" | 
| 316 |  |  |  |  |  |  | if $self->{DEBUG}; | 
| 317 | 1113 | 100 |  |  |  | 2793 | last unless $atom->size > 7;    # sanity check | 
| 318 | 1112 |  |  |  |  | 1739 | $self->{atom_count}++; | 
| 319 | 1112 | 100 |  |  |  | 2555 | if    ( $atom->type =~ /stsd/i ) { $self->ParseStsd($atom) } | 
|  | 25 | 100 |  |  |  | 91 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 320 | 14 |  |  |  |  | 61 | elsif ( $atom->type =~ /mp4a/i ) { $self->ParseMp4a($atom) } | 
| 321 | 0 |  |  |  |  | 0 | elsif ( $atom->type =~ /drms/i ) { $self->ParseDrms($atom) } | 
| 322 | 13 |  |  |  |  | 77 | elsif ( $atom->type =~ /meta/i ) { $self->ParseMeta($atom) } | 
| 323 |  |  |  |  |  |  | elsif ( $atom->isContainer() ) { | 
| 324 | 355 |  |  |  |  | 854 | $self->ParseMP4Container( | 
| 325 |  |  |  |  |  |  | $atom->node, | 
| 326 |  |  |  |  |  |  | $posit + $atom->offset, | 
| 327 |  |  |  |  |  |  | $posit + $atom->size - $atom->offset | 
| 328 |  |  |  |  |  |  | ); | 
| 329 |  |  |  |  |  |  | } | 
| 330 |  |  |  |  |  |  | else { | 
| 331 | 705 | 50 |  |  |  | 1577 | print( "done with noncontainer atom of atom of type ", | 
| 332 |  |  |  |  |  |  | $atom->type, "\n" ) | 
| 333 |  |  |  |  |  |  | if $self->{DEBUG}; | 
| 334 |  |  |  |  |  |  | } | 
| 335 | 1112 |  |  |  |  | 3406 | $posit += $atom->size; | 
| 336 |  |  |  |  |  |  | } | 
| 337 |  |  |  |  |  |  | } | 
| 338 |  |  |  |  |  |  |  | 
| 339 |  |  |  |  |  |  | sub ParseStsd { | 
| 340 | 25 |  |  | 25 | 1 | 44 | my ( $self, $stsd ) = @_; | 
| 341 | 25 |  |  |  |  | 85 | $self->ParseMP4Container( | 
| 342 |  |  |  |  |  |  | $stsd->node, | 
| 343 |  |  |  |  |  |  | $stsd->start + 16, | 
| 344 |  |  |  |  |  |  | $stsd->start + $stsd->size - 16 | 
| 345 |  |  |  |  |  |  | ); | 
| 346 |  |  |  |  |  |  | } | 
| 347 |  |  |  |  |  |  |  | 
| 348 |  |  |  |  |  |  | sub ParseMp4a { | 
| 349 | 14 |  |  | 14 | 1 | 28 | my ( $self, $mp4a ) = @_; | 
| 350 | 14 |  |  |  |  | 64 | $self->ParseMP4Container( | 
| 351 |  |  |  |  |  |  | $mp4a->node, | 
| 352 |  |  |  |  |  |  | $mp4a->start + 36, | 
| 353 |  |  |  |  |  |  | $mp4a->start + $mp4a->size - 36 | 
| 354 |  |  |  |  |  |  | ); | 
| 355 |  |  |  |  |  |  | } | 
| 356 |  |  |  |  |  |  | sub ParseDrms { | 
| 357 | 0 |  |  | 0 | 1 | 0 | my ( $self, $drms ) = @_; | 
| 358 | 0 |  |  |  |  | 0 | $self->ParseMP4Container( | 
| 359 |  |  |  |  |  |  | $drms->node, | 
| 360 |  |  |  |  |  |  | $drms->start + 36, | 
| 361 |  |  |  |  |  |  | $drms->start + $drms->size - 36 | 
| 362 |  |  |  |  |  |  | ); | 
| 363 | 0 |  |  |  |  | 0 | $self->{userID} = unpack 'N*', $self->FindAtomData('user'); | 
| 364 | 0 |  |  |  |  | 0 | my $key = $self->FindAtomData('key '); | 
| 365 | 0 | 0 |  |  |  | 0 | $self->{keyID} = unpack 'N', $key if $key; | 
| 366 | 0 |  |  |  |  | 0 | $self->{priv} = $self->FindAtomData('priv'); | 
| 367 | 0 |  |  |  |  | 0 | my $name = $self->FindAtomData('name'); | 
| 368 | 0 |  |  |  |  | 0 | $self->{name} = substr( $name, 0, index( $name, "\0" ) ); | 
| 369 | 0 |  |  |  |  | 0 | $self->{iviv} = $self->FindAtomData('iviv'); | 
| 370 | 0 | 0 |  |  |  | 0 | print "userID ", $self->{userID}, " keyID ", $self->{keyID}, "\n" | 
| 371 |  |  |  |  |  |  | if $self->{DEBUG}; | 
| 372 |  |  |  |  |  |  | } | 
| 373 |  |  |  |  |  |  |  | 
| 374 |  |  |  |  |  |  | sub ParseMeta { | 
| 375 | 13 |  |  | 13 | 1 | 29 | my ( $self, $meta ) = @_; | 
| 376 | 13 |  |  |  |  | 64 | $self->ParseMP4Container( | 
| 377 |  |  |  |  |  |  | $meta->node, | 
| 378 |  |  |  |  |  |  | $meta->start + 12, | 
| 379 |  |  |  |  |  |  | $meta->start + $meta->size - 12 | 
| 380 |  |  |  |  |  |  | ); | 
| 381 | 13 |  |  |  |  | 193 | foreach my $type ( keys %meta_info_types ) { | 
| 382 | 481 | 100 |  |  |  | 1181 | my $atom = $self->FindAtom($type) or next; | 
| 383 | 109 |  |  |  |  | 494 | my $adata = | 
| 384 |  |  |  |  |  |  | substr( $self->{buffer}, $atom->start + 24, $atom->size - 24 ); | 
| 385 | 109 | 100 |  |  |  | 349 | next if length $adata > 300; | 
| 386 | 101 | 100 |  |  |  | 621 | if ( $type eq 'disk' ) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 387 | 5 |  |  |  |  | 26 | my ( $field1, $field2 ) = unpack "nn", | 
| 388 |  |  |  |  |  |  | substr( $self->{buffer}, $atom->start + $atom->size - 4, 4 ); | 
| 389 | 5 |  |  |  |  | 22 | $adata = "Disk $field1 of $field2"; | 
| 390 |  |  |  |  |  |  | } | 
| 391 |  |  |  |  |  |  | elsif ( $type eq 'trkn' ) { | 
| 392 | 9 |  |  |  |  | 40 | my ( $fld1, $fld2 ) = unpack "nn", | 
| 393 |  |  |  |  |  |  | substr( $self->{buffer}, $atom->start + $atom->size - 6, 4 ); | 
| 394 | 9 |  |  |  |  | 38 | $adata = "Track $fld1 of $fld2"; | 
| 395 |  |  |  |  |  |  | } | 
| 396 |  |  |  |  |  |  | elsif ( $type eq 'genre' ) { | 
| 397 | 0 |  |  |  |  | 0 | $adata = unpack 'n', | 
| 398 |  |  |  |  |  |  | substr( $self->{buffer}, $atom->start + $atom->size - 2, 2 ); | 
| 399 |  |  |  |  |  |  | } | 
| 400 | 101 | 50 |  |  |  | 659 | $self->{meta}->{$type} = $adata unless length $adata > 300; | 
| 401 |  |  |  |  |  |  | } | 
| 402 | 13 | 50 |  |  |  | 160 | print $self->MetaInfo() if $self->{DEBUG}; | 
| 403 |  |  |  |  |  |  | } | 
| 404 |  |  |  |  |  |  |  | 
| 405 |  |  |  |  |  |  | sub AtomList { | 
| 406 | 3189 |  |  | 3189 | 1 | 5058 | my ($self) = @_; | 
| 407 | 3189 |  |  |  |  | 12267 | return $self->{root}->getAllRelatives();    # returns ref to list of atoms | 
| 408 |  |  |  |  |  |  | } | 
| 409 |  |  |  |  |  |  |  | 
| 410 |  |  |  |  |  |  | sub FindAtom { | 
| 411 | 3189 |  |  | 3189 | 1 | 9891 | my ( $self, $type ) = @_; | 
| 412 | 265953 | 100 | 66 |  |  | 993380 | my @atoms = | 
| 413 | 3189 |  |  |  |  | 8001 | grep { $type and $_->type and $_->type =~ /$type$/i } | 
| 414 | 3189 |  |  |  |  | 4590 | @{ $self->AtomList() }; | 
| 415 | 3189 | 100 |  |  |  | 21521 | return @atoms if wantarray; | 
| 416 | 2989 | 100 |  |  |  | 23098 | return unless scalar @atoms > 0; | 
| 417 | 1337 |  |  |  |  | 5717 | return $atoms[0]; | 
| 418 |  |  |  |  |  |  | } | 
| 419 |  |  |  |  |  |  |  | 
| 420 |  |  |  |  |  |  | sub FindAtomData { | 
| 421 | 0 |  |  | 0 | 1 | 0 | my ( $self, $type ) = @_; | 
| 422 | 0 | 0 |  |  |  | 0 | my $a = $self->FindAtom($type) or return; | 
| 423 | 0 |  |  |  |  | 0 | return $a->data; | 
| 424 |  |  |  |  |  |  | } | 
| 425 |  |  |  |  |  |  |  | 
| 426 |  |  |  |  |  |  | sub MetaInfo { | 
| 427 | 0 |  |  | 0 | 1 | 0 | my ($self)    = @_; | 
| 428 | 0 |  |  |  |  | 0 | my $meta_info = ''; | 
| 429 | 0 |  |  |  |  | 0 | my $file_type = $self->GetFtype(); | 
| 430 | 0 | 0 |  |  |  | 0 | $meta_info = "File type is $file_type\n" if $file_type; | 
| 431 | 0 |  |  |  |  | 0 | while ( my ( $mtype, $mdata ) = each %{ $self->{meta} } ) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 432 | 0 |  |  |  |  | 0 | $meta_info .= "Meta type $mtype, meta data $mdata\n"; | 
| 433 |  |  |  |  |  |  | } | 
| 434 | 0 |  |  |  |  | 0 | return $meta_info; | 
| 435 |  |  |  |  |  |  | } | 
| 436 |  |  |  |  |  |  |  | 
| 437 |  |  |  |  |  |  | sub AtomTree { | 
| 438 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 439 | 0 |  |  |  |  | 0 | return $self->{root}->AtomTree(); | 
| 440 |  |  |  |  |  |  | } | 
| 441 |  |  |  |  |  |  |  | 
| 442 |  |  |  |  |  |  | sub DumpTree { | 
| 443 | 0 |  |  | 0 | 1 | 0 | my ( $self, $outfile ) = @_; | 
| 444 | 0 | 0 | 0 |  |  | 0 | if ( $outfile and open( my $dumpfh, ">$outfile" ) ) { | 
| 445 | 0 |  |  |  |  | 0 | print $dumpfh $self->AtomTree(); | 
| 446 | 0 |  |  |  |  | 0 | close $dumpfh; | 
| 447 |  |  |  |  |  |  | } | 
| 448 | 0 |  |  |  |  | 0 | else { print $self->AtomTree() } | 
| 449 |  |  |  |  |  |  | } | 
| 450 |  |  |  |  |  |  |  | 
| 451 |  |  |  |  |  |  | sub ConvertDrmsToMp4a { | 
| 452 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 453 | 0 |  |  |  |  | 0 | my $diff = 0; | 
| 454 | 0 | 0 |  |  |  | 0 | my $drms = $self->FindAtom('drms') or return; | 
| 455 | 0 |  |  |  |  | 0 | foreach my $a (@m4p_not_m4a_atom_types) { | 
| 456 | 0 | 0 |  |  |  | 0 | my @unwanted = $self->FindAtom($a) or next; | 
| 457 | 0 |  |  |  |  | 0 | foreach my $u (@unwanted) { $diff += $u->size; $u->selfDelete() } | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 458 |  |  |  |  |  |  | } | 
| 459 | 0 | 0 |  |  |  | 0 | print "Shrunk file by $diff bytes during conversion\n" if $self->{DEBUG}; | 
| 460 | 0 |  |  |  |  | 0 | $self->FixStco( $diff, $drms->start ); | 
| 461 | 0 |  |  |  |  | 0 | $drms->type('mp4a'); | 
| 462 |  |  |  |  |  |  | } | 
| 463 |  |  |  |  |  |  |  | 
| 464 |  |  |  |  |  |  | sub FixStco { | 
| 465 | 49 |  |  | 49 | 1 | 164 | my ( $self, $sinf_sz, $change_position ) = @_; | 
| 466 | 49 |  |  |  |  | 232 | my @stco_atoms = $self->FindAtom('stco'); | 
| 467 | 49 |  |  |  |  | 237 | my @co64_atoms = $self->FindAtom('co64'); | 
| 468 | 49 |  |  |  |  | 194 | my @tfhd_atoms = $self->FindAtom('tfhd'); | 
| 469 |  |  |  |  |  |  |  | 
| 470 |  |  |  |  |  |  | # all Quicktime files should have at least one stco or co64 atom | 
| 471 | 49 | 50 | 33 |  |  | 279 | croak 'No stco or co64 atom' unless @stco_atoms || @co64_atoms; | 
| 472 |  |  |  |  |  |  |  | 
| 473 |  |  |  |  |  |  | # if mdat is before change postion will not need to do anything | 
| 474 | 49 | 50 |  |  |  | 176 | my @mdat = $self->FindAtom('mdat') or return; | 
| 475 | 49 |  |  |  |  | 135 | my $all_mdat_before = 1; | 
| 476 | 49 |  |  |  |  | 129 | foreach my $mdt (@mdat) { | 
| 477 | 181 | 50 |  |  |  | 608 | $all_mdat_before = 0 if $mdt->start > $change_position; | 
| 478 |  |  |  |  |  |  | } | 
| 479 | 49 | 50 |  |  |  | 233 | return if $all_mdat_before; | 
| 480 |  |  |  |  |  |  |  | 
| 481 | 49 |  |  |  |  | 119 | foreach my $stco (@stco_atoms) { | 
| 482 | 1064 | 50 |  |  |  | 2172 | my @samples = | 
| 483 | 82 |  |  |  |  | 366 | map { ( $_ > $change_position ) ? $_ - $sinf_sz : $_ } | 
| 484 |  |  |  |  |  |  | unpack( "N*", | 
| 485 |  |  |  |  |  |  | substr( $self->{buffer}, $stco->start + 16, $stco->size - 16 ) ); | 
| 486 | 82 |  |  |  |  | 345 | substr( | 
| 487 |  |  |  |  |  |  | $self->{buffer}, | 
| 488 |  |  |  |  |  |  | $stco->start + 16, | 
| 489 |  |  |  |  |  |  | $stco->size - 16, | 
| 490 |  |  |  |  |  |  | pack( 'N*', @samples ) | 
| 491 |  |  |  |  |  |  | ); | 
| 492 |  |  |  |  |  |  | } | 
| 493 | 49 |  |  |  |  | 152 | foreach my $co64 (@co64_atoms) { | 
| 494 | 1 |  |  |  |  | 4 | my @samples = | 
| 495 |  |  |  |  |  |  | unpack( "N*", | 
| 496 |  |  |  |  |  |  | substr( $self->{buffer}, $co64->start + 16, $co64->size - 16 ) ); | 
| 497 | 1 |  |  |  |  | 3 | my $num_longs = scalar @samples; | 
| 498 | 1 |  |  |  |  | 5 | for ( my $i = 0 ; $i < $num_longs ; $i += 2 ) { | 
| 499 | 16 |  |  |  |  | 16 | my $high32bits = $samples[$i]; | 
| 500 | 16 |  |  |  |  | 16 | my $low32bits  = $samples[ $i + 1 ]; | 
| 501 | 16 |  |  |  |  | 18 | my $offset64   = ( $high32bits * ( 2**32 ) ) + $low32bits; | 
| 502 | 16 | 50 |  |  |  | 31 | $offset64 -= $sinf_sz if $offset64 > $change_position; | 
| 503 | 16 |  |  |  |  | 18 | $samples[ $i + 1 ] = $offset64 % ( 2**32 ); | 
| 504 | 16 |  |  |  |  | 37 | $samples[$i] = int( $offset64 / ( 2**32 ) + 0.0001 ); | 
| 505 |  |  |  |  |  |  | } | 
| 506 | 1 |  |  |  |  | 5 | substr( | 
| 507 |  |  |  |  |  |  | $self->{buffer}, | 
| 508 |  |  |  |  |  |  | $co64->start + 16, | 
| 509 |  |  |  |  |  |  | $co64->size - 16, | 
| 510 |  |  |  |  |  |  | pack( 'N*', @samples ) | 
| 511 |  |  |  |  |  |  | ); | 
| 512 |  |  |  |  |  |  | } | 
| 513 | 49 |  |  |  |  | 332 | foreach my $tfhd (@tfhd_atoms) { | 
| 514 | 132 |  |  |  |  | 393 | my ( $tf_flags, undef, $offset_high32, $offset_low32 ) = | 
| 515 |  |  |  |  |  |  | unpack( 'NNNN', substr( $self->{buffer}, $tfhd->start + 8, 16 ) ); | 
| 516 |  |  |  |  |  |  |  | 
| 517 |  |  |  |  |  |  | # we only need to adjust if the 1st movie fragment tf_flags bit is set | 
| 518 | 132 | 50 |  |  |  | 326 | next unless ( ( $tf_flags % 2 ) == 1 ); | 
| 519 |  |  |  |  |  |  |  | 
| 520 | 132 |  |  |  |  | 160 | my $offset64 = ( $offset_high32 * ( 2**32 ) ) + $offset_low32; | 
| 521 | 132 | 50 |  |  |  | 241 | next if $offset64 < $change_position; | 
| 522 |  |  |  |  |  |  |  | 
| 523 | 132 |  |  |  |  | 139 | $offset64 -= $sinf_sz; | 
| 524 | 132 |  |  |  |  | 180 | $offset_high32 = int( $offset64 / ( 2**32 ) + 0.0001 ); | 
| 525 | 132 |  |  |  |  | 148 | $offset_low32 = $offset64 % ( 2**32 ); | 
| 526 | 132 |  |  |  |  | 350 | substr( $self->{buffer}, $tfhd->start + 16, | 
| 527 |  |  |  |  |  |  | 8, pack( 'NN', $offset_high32, $offset_low32 ) ); | 
| 528 |  |  |  |  |  |  | } | 
| 529 |  |  |  |  |  |  | } | 
| 530 |  |  |  |  |  |  |  | 
| 531 |  |  |  |  |  |  | sub GetSampleTable { | 
| 532 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 533 | 0 | 0 |  |  |  | 0 | my $stsz = $self->FindAtom('stsz') or croak "No stsz table found"; | 
| 534 | 0 |  |  |  |  | 0 | my $sampleCount = unpack 'N', | 
| 535 |  |  |  |  |  |  | substr( $self->{buffer}, $stsz->start + 16, 4 ); | 
| 536 | 0 |  |  |  |  | 0 | my @samples = unpack 'N*', | 
| 537 |  |  |  |  |  |  | substr( $self->{buffer}, $stsz->start + 20, $sampleCount * 4 ); | 
| 538 | 0 | 0 |  |  |  | 0 | print "There are $sampleCount samples in stsz atom.\n" if $self->{DEBUG}; | 
| 539 | 0 |  |  |  |  | 0 | return \@samples; | 
| 540 |  |  |  |  |  |  | } | 
| 541 |  |  |  |  |  |  |  | 
| 542 |  |  |  |  |  |  | sub DeleteAtom { | 
| 543 | 0 |  |  | 0 | 1 | 0 | my ( $self, $unwanted ) = @_; | 
| 544 | 0 | 0 |  |  |  | 0 | my $atom = $self->FindAtom($unwanted) or return; | 
| 545 | 0 |  |  |  |  | 0 | return $atom->selfDelete(); | 
| 546 |  |  |  |  |  |  | } | 
| 547 |  |  |  |  |  |  |  | 
| 548 |  |  |  |  |  |  | sub DeleteAtomWithStcoFix { | 
| 549 | 1 |  |  | 1 | 1 | 792 | my ( $self, $unwanted ) = @_; | 
| 550 | 1 | 50 |  |  |  | 5 | my $atom = $self->FindAtom($unwanted) or return; | 
| 551 | 1 |  |  |  |  | 5 | my $siz  = $atom->size; | 
| 552 | 1 |  |  |  |  | 5 | my $pos  = $atom->start; | 
| 553 | 1 | 50 |  |  |  | 6 | $atom->selfDelete() or return; | 
| 554 | 1 |  |  |  |  | 6 | $self->FixStco( $siz, $pos ); | 
| 555 | 1 |  |  |  |  | 5 | return 1; | 
| 556 |  |  |  |  |  |  | } | 
| 557 |  |  |  |  |  |  |  | 
| 558 |  |  |  |  |  |  | sub CleanAppleM4aPersonalData { | 
| 559 | 0 |  |  | 0 | 1 | 0 | my ( $self, %args ) = @_; | 
| 560 | 0 | 0 | 0 |  |  | 0 | if( $self->FindAtom("mp4a") or $args{force} ) { | 
| 561 | 0 |  |  |  |  | 0 | foreach my $atm (@apple_user_id_atoms) { | 
| 562 | 0 |  |  |  |  | 0 | $self->DeleteAtomWithStcoFix($atm); | 
| 563 |  |  |  |  |  |  | } | 
| 564 |  |  |  |  |  |  | } | 
| 565 | 0 | 0 |  |  |  | 0 | if( $args{zero_free_atoms} ) { | 
| 566 | 0 |  |  |  |  | 0 | my @free_atoms = $self->FindAtom("free"); | 
| 567 | 0 |  |  |  |  | 0 | foreach my $atm (@free_atoms) { | 
| 568 | 0 |  |  |  |  | 0 | my $data_size = $atm->{size} - $atm->{offset}; | 
| 569 | 0 |  |  |  |  | 0 | substr( ${ $atm->{rbuf} }, $atm->{start} + $atm->{offset}, | 
|  | 0 |  |  |  |  | 0 |  | 
| 570 |  |  |  |  |  |  | $data_size, "\x0" x $data_size ); | 
| 571 |  |  |  |  |  |  | } | 
| 572 |  |  |  |  |  |  | } | 
| 573 |  |  |  |  |  |  | } | 
| 574 |  |  |  |  |  |  |  | 
| 575 |  |  |  |  |  |  | sub GetFtype { | 
| 576 | 209 |  |  | 209 | 1 | 390 | my ($self) = @_; | 
| 577 | 209 | 50 |  |  |  | 601 | my $atom = $self->FindAtom('ftyp') or return; | 
| 578 | 209 |  |  |  |  | 1015 | my $ftyp = substr( $atom->data, 0, 4 ); | 
| 579 | 209 |  |  |  |  | 2100 | $ftyp =~ s/^(\S+)\s+$/$1/; | 
| 580 | 209 |  |  |  |  | 1266 | return $ftyp; | 
| 581 |  |  |  |  |  |  | } | 
| 582 |  |  |  |  |  |  |  | 
| 583 |  |  |  |  |  |  | sub Get3GPInfo { | 
| 584 | 13 |  |  | 13 | 1 | 33 | my ($self) = @_; | 
| 585 | 13 |  |  |  |  | 122 | while ( my ( $meta_type, $atom_type ) = each %asset_3GP_types ) { | 
| 586 | 156 | 50 |  |  |  | 833 | my $atom = $self->FindAtom($atom_type) or next; | 
| 587 | 0 |  |  |  |  | 0 | my $data = | 
| 588 |  |  |  |  |  |  | substr( $atom->{buffer}, $atom->start + 14, $atom->size - 14 ); | 
| 589 | 0 |  |  |  |  | 0 | $self->{MP4Info}->{$meta_type} = $data; | 
| 590 |  |  |  |  |  |  | } | 
| 591 | 13 |  |  |  |  | 118 | while ( my ( $tag, $alt_tag ) = each %alternate_tag_types ) { | 
| 592 | 104 | 50 |  |  |  | 494 | $self->{MP4Info}->{$alt_tag} = $self->{MP4Info}->{$tag} | 
| 593 |  |  |  |  |  |  | if exists $self->{MP4Info}->{$tag}; | 
| 594 |  |  |  |  |  |  | } | 
| 595 | 13 |  |  |  |  | 64 | my $file_type = $self->GetFtype(); | 
| 596 | 13 | 50 |  |  |  | 112 | $self->{MP4Info}->{FTYP} = $file_type if $file_type; | 
| 597 | 13 |  |  |  |  | 77 | return $self->{MP4Info}; | 
| 598 |  |  |  |  |  |  | } | 
| 599 |  |  |  |  |  |  |  | 
| 600 |  |  |  |  |  |  | sub Set3GPInfo { | 
| 601 | 3 |  |  | 3 | 1 | 9 | my ( $self, $field, $value, $delete_old ) = @_; | 
| 602 | 3 |  |  |  |  | 15 | my $asset_type = $asset_3GP_types{$field}; | 
| 603 | 3 | 50 |  |  |  | 14 | my $moov = $self->FindAtom('moov') or croak "No moov atom found"; | 
| 604 | 3 |  |  |  |  | 7 | my ( $asset, $udta ); | 
| 605 | 3 |  |  |  |  | 20 | foreach my $typ ( values %asset_3GP_types ) { | 
| 606 | 36 | 50 |  |  |  | 160 | $asset = $self->FindAtom($typ) or next; | 
| 607 | 0 |  |  |  |  | 0 | $udta = $asset->GetParent(); | 
| 608 | 0 | 0 | 0 |  |  | 0 | last if $udta and $udta->{type} =~ /udta/i; | 
| 609 | 0 |  |  |  |  | 0 | $udta = 0; | 
| 610 |  |  |  |  |  |  | } | 
| 611 |  |  |  |  |  |  |  | 
| 612 |  |  |  |  |  |  | # if cannot find any asset atoms, look for the udta child of moov | 
| 613 | 3 | 50 |  |  |  | 30 | $udta = $moov->DirectChildren('udta') unless $udta; | 
| 614 |  |  |  |  |  |  |  | 
| 615 |  |  |  |  |  |  | # if no direct child of moov udta, make one | 
| 616 | 3 | 100 |  |  |  | 12 | unless ($udta) { | 
| 617 | 1 |  |  |  |  | 6 | $moov->insertNew( 'udta', '' ); | 
| 618 | 1 |  |  |  |  | 9 | $self->FixStco( -8, $moov->start ); | 
| 619 | 1 |  |  |  |  | 7 | $udta = $moov->Contained('udta'); | 
| 620 |  |  |  |  |  |  | } | 
| 621 | 3 |  |  |  |  | 11 | my $entry = $udta->Contained($asset_type); | 
| 622 | 3 |  |  |  |  | 7 | my $diff  = 0; | 
| 623 | 3 | 50 | 33 |  |  | 14 | if ( $entry and $delete_old ) { | 
| 624 | 0 |  |  |  |  | 0 | my @unwanted = $udta->Contained($asset_type); | 
| 625 | 0 |  |  |  |  | 0 | foreach my $u (@unwanted) { | 
| 626 | 0 |  |  |  |  | 0 | $diff += $u->size; | 
| 627 | 0 |  |  |  |  | 0 | $u->selfDelete; | 
| 628 |  |  |  |  |  |  | } | 
| 629 |  |  |  |  |  |  | } | 
| 630 |  |  |  |  |  |  |  | 
| 631 |  |  |  |  |  |  | # now we can add the data | 
| 632 |  |  |  |  |  |  | # we set language code to 'eng' | 
| 633 | 3 |  |  |  |  | 8 | my $lang        = $default_asset_3GP_lang; | 
| 634 | 3 |  |  |  |  | 12 | my $packed_lang = asset_language_pack_iso_639_2T($lang); | 
| 635 | 3 |  |  |  |  | 22 | my $data_packet = pack( 'Nn', 0, $packed_lang ) . $value; | 
| 636 | 3 |  |  |  |  | 14 | my $new_atom    = $udta->insertNew( $asset_type, $data_packet ); | 
| 637 | 3 |  |  |  |  | 12 | $diff -= $new_atom->size; | 
| 638 | 3 |  |  |  |  | 15 | $self->FixStco( $diff, $udta->start ); | 
| 639 | 3 |  |  |  |  | 28 | return $new_atom; | 
| 640 |  |  |  |  |  |  | } | 
| 641 |  |  |  |  |  |  |  | 
| 642 |  |  |  |  |  |  | sub GetMetaInfo { | 
| 643 | 85 |  |  | 85 | 1 | 2247 | my ( $self, $as_text ) = @_; | 
| 644 |  |  |  |  |  |  |  | 
| 645 |  |  |  |  |  |  | # if we have a 3gp file, dispatch | 
| 646 | 85 | 100 |  |  |  | 321 | return $self->Get3GPInfo() if $self->GetFtype() =~ /^3g/; | 
| 647 |  |  |  |  |  |  |  | 
| 648 | 72 |  |  |  |  | 129 | my %meta_tags; | 
| 649 | 72 |  |  |  |  | 464 | while ( my ( $meta_tag, $type ) = each %tag_types ) { | 
| 650 | 1944 |  |  |  |  | 10299 | $type =~ s/\W//g; | 
| 651 | 1944 | 100 |  |  |  | 5692 | my $atm      = $self->FindAtom($type)  or next; | 
| 652 | 903 | 100 |  |  |  | 4675 | my $data_atm = $atm->Contained('data') or next; | 
| 653 | 897 |  |  |  |  | 3295 | my $data     = $data_atm->data; | 
| 654 | 897 | 100 |  |  |  | 3673 | if ( $type eq 'gnre' ) { | 
|  |  | 100 |  |  |  |  |  | 
| 655 | 92 |  |  |  |  | 597 | ( undef, undef, $data ) = unpack 'NNn', $data; | 
| 656 |  |  |  |  |  |  | } | 
| 657 |  |  |  |  |  |  | elsif ( $type eq 'trkn' ) { | 
| 658 | 78 |  |  |  |  | 707 | ( undef, undef, undef, $data, $self->{MP4Info}->{TRACKCOUNT} ) = | 
| 659 |  |  |  |  |  |  | unpack 'NNnnn', $data; | 
| 660 |  |  |  |  |  |  | } | 
| 661 |  |  |  |  |  |  | else { | 
| 662 | 727 |  |  |  |  | 2742 | my $firstchar = unpack( 'C', $data ); | 
| 663 | 727 | 50 |  |  |  | 2010 | if ( $firstchar == 0 ) { | 
| 664 | 727 |  |  |  |  | 2770 | $data = substr( $data, 8 ); | 
| 665 | 727 | 100 |  |  |  | 2654 | utf8::decode($data) if ($utf8_atoms{$type}); | 
| 666 |  |  |  |  |  |  | } | 
| 667 |  |  |  |  |  |  | } | 
| 668 | 897 |  |  |  |  | 2711 | $self->{MP4Info}->{$meta_tag} = $data; | 
| 669 | 897 |  |  |  |  | 4025 | while ( my ( $tag, $alt_tag ) = each %alternate_tag_types ) { | 
| 670 | 7176 | 100 |  |  |  | 39828 | $self->{MP4Info}->{$alt_tag} = $self->{MP4Info}->{$tag} | 
| 671 |  |  |  |  |  |  | if defined $self->{MP4Info}->{$tag}; | 
| 672 |  |  |  |  |  |  | } | 
| 673 |  |  |  |  |  |  | } | 
| 674 |  |  |  |  |  |  |  | 
| 675 | 72 | 100 |  |  |  | 988 | if( !$self->{MP4Info}->{GENRE} ) { | 
| 676 | 26 |  |  |  |  | 93 | my $gen_atom = $self->FindAtom('©gen'); | 
| 677 | 26 | 50 |  |  |  | 110 | if($gen_atom) { | 
| 678 | 0 |  |  |  |  | 0 | my $genre_txt = substr $gen_atom->data, 16; | 
| 679 | 0 |  |  |  |  | 0 | my $genre_num = $genre_text_to_genre_numbers{$genre_txt}; | 
| 680 | 0 |  |  |  |  | 0 | $self->{MP4Info}->{GENRE} = $self->{MP4Info}->{GNRE} = $genre_num; | 
| 681 |  |  |  |  |  |  | } | 
| 682 |  |  |  |  |  |  | } | 
| 683 |  |  |  |  |  |  |  | 
| 684 | 72 | 100 |  |  |  | 267 | if ($as_text) { | 
| 685 |  |  |  |  |  |  | # if as_text, we need to convert the tags to text | 
| 686 | 2 | 50 |  |  |  | 14 | if ( defined $self->{MP4Info}->{DISK} ) { | 
| 687 | 2 |  |  |  |  | 15 | ( undef, my $disknum, my $disks ) = unpack 'nnn', | 
| 688 |  |  |  |  |  |  | $self->{MP4Info}->{DISK}; | 
| 689 | 2 |  |  |  |  | 12 | $self->{MP4Info}->{DISK} = "Disk $disknum of $disks"; | 
| 690 |  |  |  |  |  |  | } | 
| 691 | 2 | 50 |  |  |  | 13 | if ( defined $self->{MP4Info}->{TRKN} ) { | 
| 692 | 2 |  |  |  |  | 10 | ( undef, my $tracknum, my $tracks ) = unpack 'nnn', | 
| 693 |  |  |  |  |  |  | $self->{MP4Info}->{TRKN}; | 
| 694 | 2 | 50 | 33 |  |  | 28 | $self->{MP4Info}->{TRKN} = "Track $tracknum of $tracks" | 
| 695 |  |  |  |  |  |  | if $tracknum && $tracks; | 
| 696 |  |  |  |  |  |  | } | 
| 697 | 2 | 50 |  |  |  | 11 | if ( defined $self->{MP4Info}->{TMPO} ) { | 
| 698 | 2 |  |  |  |  | 8 | my $tempo = unpack 'n', $self->{MP4Info}->{TMPO}; | 
| 699 | 2 |  | 50 |  |  | 18 | $self->{MP4Info}->{TMPO} = $tempo || "Undefined"; | 
| 700 |  |  |  |  |  |  | } | 
| 701 | 2 | 50 | 33 |  |  | 26 | if( defined $self->{MP4Info}->{CPRT} && | 
| 702 |  |  |  |  |  |  | length( $self->{MP4Info}->{CPRT} ) > 3 ) { | 
| 703 | 2 |  |  |  |  | 15 | $self->{MP4Info}->{CPRT} = substr( $self->{MP4Info}->{CPRT}, 3 ); | 
| 704 |  |  |  |  |  |  | } | 
| 705 | 2 | 50 |  |  |  | 9 | if ( defined $self->{MP4Info}->{COVR} ) { | 
| 706 | 2 |  |  |  |  | 6 | $self->{MP4Info}->{COVR} = "Coverart present"; | 
| 707 |  |  |  |  |  |  | } | 
| 708 | 2 | 50 | 33 |  |  | 39 | if (    defined $self->{MP4Info}->{GENRE} | 
|  |  |  | 33 |  |  |  |  | 
| 709 |  |  |  |  |  |  | and $self->{MP4Info}->{GENRE} =~ /^\d+$/ | 
| 710 |  |  |  |  |  |  | and $self->{MP4Info}->{GENRE} < 128 ) | 
| 711 |  |  |  |  |  |  | { | 
| 712 | 2 |  |  |  |  | 11 | $self->{MP4Info}->{GENRE} = | 
| 713 |  |  |  |  |  |  | $genre_strings[ $self->{MP4Info}->{GENRE} - 1 ]; | 
| 714 |  |  |  |  |  |  | } | 
| 715 |  |  |  |  |  |  | } | 
| 716 | 72 |  |  |  |  | 361 | $self->{MP4Info}->{FTYP} = $self->GetFtype(); | 
| 717 | 72 |  |  |  |  | 306 | return $self->{MP4Info}; | 
| 718 |  |  |  |  |  |  | } | 
| 719 |  |  |  |  |  |  |  | 
| 720 |  |  |  |  |  |  | sub GetMP4Info { | 
| 721 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 722 | 0 |  |  |  |  | 0 | my $meta = $self->GetMetaInfo(); | 
| 723 | 0 |  |  |  |  | 0 | $meta->{LAYER}     = 1; | 
| 724 | 0 |  |  |  |  | 0 | $meta->{VERSION}   = 4; | 
| 725 | 0 | 0 |  |  |  | 0 | $meta->{COPYRIGHT} = ( exists $meta->{CPRT} ) ? 1 : 0; | 
| 726 | 0 |  |  |  |  | 0 | my $mdat = $self->FindAtom('mdat'); | 
| 727 | 0 |  | 0 |  |  | 0 | $meta->{SIZE} = $mdat->size || 1; | 
| 728 | 0 |  |  |  |  | 0 | $meta->{ENCRYPTED} = $self->FindAtom('drms'); | 
| 729 | 0 |  |  |  |  | 0 | my $mvhd_data = $self->FindAtomData('mvhd'); | 
| 730 | 0 |  |  |  |  | 0 | my ( $timescale, $duration ); | 
| 731 |  |  |  |  |  |  |  | 
| 732 | 0 | 0 |  |  |  | 0 | if ($mvhd_data) { | 
| 733 | 0 |  |  |  |  | 0 | my @mvhd = unpack( 'Ca3NNNNNN', $mvhd_data ); | 
| 734 | 0 | 0 |  |  |  | 0 | if ( $mvhd[0] == 1 ) { | 
| 735 | 0 |  |  |  |  | 0 | $timescale = $mvhd[6]; | 
| 736 | 0 |  |  |  |  | 0 | $duration = ( $mvhd[7] * ( 2**32 ) + $mvhd[8] ) / $mvhd[6]; | 
| 737 |  |  |  |  |  |  | } | 
| 738 |  |  |  |  |  |  | else { | 
| 739 | 0 |  |  |  |  | 0 | $timescale = $mvhd[4]; | 
| 740 | 0 |  |  |  |  | 0 | $duration  = $mvhd[5]; | 
| 741 |  |  |  |  |  |  | } | 
| 742 | 0 |  |  |  |  | 0 | $meta->{SECONDS} = int( $duration / $timescale + 0.5 ); | 
| 743 | 0 |  |  |  |  | 0 | $meta->{MM}      = int( $meta->{SECONDS} / 60 ); | 
| 744 | 0 |  |  |  |  | 0 | $meta->{SS}      = $meta->{SECONDS} % 60; | 
| 745 | 0 |  |  |  |  | 0 | $meta->{BITRATE} = int( $meta->{SIZE} / $meta->{SECONDS} + 0.5 ); | 
| 746 |  |  |  |  |  |  | } | 
| 747 | 0 |  |  |  |  | 0 | return $meta; | 
| 748 |  |  |  |  |  |  | } | 
| 749 |  |  |  |  |  |  |  | 
| 750 |  |  |  |  |  |  | sub SetMetaInfo { | 
| 751 | 39 |  |  | 39 | 1 | 1087 | my ( $self, $field, $value, $delete_old, $before, $as_text ) = @_; | 
| 752 | 39 |  |  |  |  | 168 | $self->GetMetaInfo;    # fill default fields like TRACKCOUNT | 
| 753 |  |  |  |  |  |  |  | 
| 754 |  |  |  |  |  |  | # if we have a 3gp file, dispatch | 
| 755 | 39 | 100 |  |  |  | 157 | return $self->Set3GPInfo( $self, $field, $value, $delete_old ) | 
| 756 |  |  |  |  |  |  | if $self->GetFtype() =~ /^3g/; | 
| 757 |  |  |  |  |  |  |  | 
| 758 | 36 |  | 66 |  |  | 291 | my $type = $tag_types{$field} || lc substr( $field, 0, 4 ); | 
| 759 | 36 |  | 50 |  |  | 131 | my $ilst = $self->FindAtom('ilst') || $self->MakeIlstAtom || return; | 
| 760 | 36 |  |  |  |  | 104 | my $typ = $type; | 
| 761 | 36 |  |  |  |  | 216 | $typ =~ s/\W//g; | 
| 762 | 36 |  |  |  |  | 190 | my $entry = $ilst->Contained($typ); | 
| 763 | 36 |  |  |  |  | 87 | my $diff  = 0; | 
| 764 | 36 | 100 | 100 |  |  | 159 | if ( $entry and $delete_old ) { | 
| 765 | 13 |  |  |  |  | 39 | my @unwanted = $ilst->Contained($typ); | 
| 766 | 13 |  |  |  |  | 24 | foreach my $u (@unwanted) { | 
| 767 | 13 |  |  |  |  | 64 | $diff += $u->size; | 
| 768 | 13 |  |  |  |  | 72 | $u->selfDelete; | 
| 769 |  |  |  |  |  |  | } | 
| 770 |  |  |  |  |  |  | } | 
| 771 | 36 | 100 |  |  |  | 110 | if ($as_text) { | 
| 772 | 4 |  |  |  |  | 101 | my %iTMS_meta_atoms = reverse %iTMS_dict_meta_types; | 
| 773 | 4 | 50 |  |  |  | 26 | if ( $iTMS_meta_atoms{$type} ) { | 
| 774 | 4 |  |  |  |  | 8 | my %h; | 
| 775 | 4 | 50 | 33 |  |  | 95 | if ( $type eq 'disk' and $value =~ m/(\d+)\D+(\d+)/ ) { | 
|  |  | 100 | 66 |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 776 | 0 |  |  |  |  | 0 | $h{discNumber} = $1; | 
| 777 | 0 |  |  |  |  | 0 | $h{discCount}  = $2; | 
| 778 |  |  |  |  |  |  | } | 
| 779 |  |  |  |  |  |  | elsif ( $type eq 'trkn' and $value =~ m/(\d+)\D+(\d+)/ ) { | 
| 780 | 3 |  |  |  |  | 23 | $h{trackNumber} = $1; | 
| 781 | 3 |  |  |  |  | 22 | $h{trackCount}  = $2; | 
| 782 |  |  |  |  |  |  | } | 
| 783 |  |  |  |  |  |  | elsif ( $type eq 'gnre' ) { | 
| 784 | 0 |  |  |  |  | 0 | $value = genre_text_to_genre_num($value); | 
| 785 |  |  |  |  |  |  | } | 
| 786 | 1 |  |  |  |  | 4 | else { $h{ $iTMS_meta_atoms{$type} } = $value } | 
| 787 | 4 | 100 |  |  |  | 21 | $self->FixStco( $diff, $ilst->start ) if $diff; | 
| 788 | 4 |  |  |  |  | 25 | return $self->iTMS_MetaInfo( \%h, 1 ); | 
| 789 |  |  |  |  |  |  | } | 
| 790 |  |  |  |  |  |  | } | 
| 791 | 32 | 100 | 100 |  |  | 181 | if ( $typ eq 'covr' and $ilst->Contained($typ) ) { | 
| 792 | 1 |  |  |  |  | 8 | $ilst->addMoreArtwork($value); | 
| 793 | 1 |  |  |  |  | 3 | $diff -= 16; | 
| 794 |  |  |  |  |  |  | } | 
| 795 |  |  |  |  |  |  | else { | 
| 796 | 31 | 100 |  |  |  | 239 | utf8::encode($value) if ($utf8_atoms{$type}); | 
| 797 | 31 |  |  |  |  | 178 | $ilst->insertNewMetaData( $type, $value, $before ); | 
| 798 | 31 |  |  |  |  | 85 | $diff -= 24; | 
| 799 |  |  |  |  |  |  | } | 
| 800 | 32 |  |  |  |  | 70 | $diff -= length $value; | 
| 801 | 32 |  |  |  |  | 143 | $self->FixStco( $diff, $ilst->start ); | 
| 802 |  |  |  |  |  |  | } | 
| 803 |  |  |  |  |  |  |  | 
| 804 |  |  |  |  |  |  | sub MakeIlstAtom { | 
| 805 | 2 |  |  | 2 | 1 | 6 | my ($self) = @_; | 
| 806 | 2 | 50 |  |  |  | 26 | my $moov = $self->FindAtom('moov') or croak "No moov atom found"; | 
| 807 | 2 |  |  |  |  | 17 | my $udta = $moov->DirectChildren('udta'); | 
| 808 |  |  |  |  |  |  |  | 
| 809 |  |  |  |  |  |  | # if no udta under moov, make one under moov | 
| 810 | 2 | 50 |  |  |  | 8 | unless ($udta) { | 
| 811 | 0 |  |  |  |  | 0 | $moov->insertNew( 'udta', '' ); | 
| 812 | 0 |  |  |  |  | 0 | $self->FixStco( -8, $moov->start ); | 
| 813 | 0 |  |  |  |  | 0 | $udta = $moov->Contained('udta'); | 
| 814 |  |  |  |  |  |  | } | 
| 815 |  |  |  |  |  |  |  | 
| 816 |  |  |  |  |  |  | # if we have a meta atom, add an hdlr atom and ilst to it | 
| 817 |  |  |  |  |  |  | # if we do not have one make one | 
| 818 | 2 |  |  |  |  | 5 | my ( $meta, $hdlr, $ilst ); | 
| 819 | 2 |  |  |  |  | 8 | $meta = $udta->Contained('meta'); | 
| 820 | 2 | 50 |  |  |  | 14 | unless ($meta) { | 
| 821 | 2 |  |  |  |  | 13 | $udta->insertNew( 'meta', "\0\0\0\0" ); | 
| 822 | 2 |  |  |  |  | 10 | $self->FixStco( -12, $udta->start ); | 
| 823 | 2 |  |  |  |  | 12 | $meta = $udta->Contained('meta'); | 
| 824 |  |  |  |  |  |  | } | 
| 825 | 2 |  |  |  |  | 10 | $hdlr = $meta->Contained('hdlr'); | 
| 826 | 2 | 50 |  |  |  | 7 | unless ($hdlr) { | 
| 827 | 2 |  |  |  |  | 13 | $meta->insertNew( 'hdlr', | 
| 828 |  |  |  |  |  |  | "\0\0\0\0\0\0\0\0mdirappl\0\0\0\0\0\0\0\0\0" ); | 
| 829 | 2 |  |  |  |  | 8 | $self->FixStco( -33, $meta->start ); | 
| 830 | 2 |  |  |  |  | 16 | $hdlr = $meta->Contained('hdlr'); | 
| 831 |  |  |  |  |  |  | } | 
| 832 | 2 |  |  |  |  | 11 | $ilst = $meta->Contained('ilst'); | 
| 833 | 2 | 50 |  |  |  | 12 | unless ($ilst) { | 
| 834 | 2 |  |  |  |  | 11 | $meta->insertNew( 'ilst', '' ); | 
| 835 | 2 |  |  |  |  | 9 | $self->FixStco( -8, $meta->start ); | 
| 836 | 2 |  |  |  |  | 15 | $ilst = $meta->Contained('ilst'); | 
| 837 |  |  |  |  |  |  | } | 
| 838 | 2 |  |  |  |  | 22 | return $ilst; | 
| 839 |  |  |  |  |  |  | } | 
| 840 |  |  |  |  |  |  |  | 
| 841 |  |  |  |  |  |  | sub iTMS_MetaInfo { | 
| 842 | 6 |  |  | 6 | 1 | 748 | my ( $self, $dict, $keep_old ) = @_; | 
| 843 | 6 |  |  |  |  | 15 | my ( $key, $type, %info ); | 
| 844 | 6 | 100 |  |  |  | 23 | if ($dict) { | 
| 845 | 5 |  |  |  |  | 39 | while ( ( $key, $type ) = each %iTMS_dict_meta_types ) { | 
| 846 | 70 | 100 |  |  |  | 224 | next if $key =~ /Count$/; | 
| 847 | 60 | 100 |  |  |  | 221 | next unless exists $dict->{$key}; | 
| 848 | 14 |  |  |  |  | 38 | my $data = $dict->{$key}; | 
| 849 | 14 | 100 |  |  |  | 47 | if ( $key eq 'discNumber' ) { | 
| 850 | 1 | 50 |  |  |  | 6 | my $count = $dict->{discCount} or next; | 
| 851 | 1 |  |  |  |  | 7 | $data = pack "nnn", 0, $data, $count; | 
| 852 |  |  |  |  |  |  | } | 
| 853 | 14 | 100 |  |  |  | 48 | if ( $key eq 'trackNumber' ) { | 
| 854 | 4 |  | 50 |  |  | 36 | my $count = $dict->{trackCount} || 0; | 
| 855 | 4 |  |  |  |  | 33 | $data = pack "nnnn", 0, $data, $count, 0; | 
| 856 |  |  |  |  |  |  | } | 
| 857 | 14 | 50 |  |  |  | 45 | if ( $key eq 'artworkURL' ) { | 
| 858 | 0 |  |  |  |  | 0 | eval 'require LWP::Simple; $data = get($data)'; | 
| 859 |  |  |  |  |  |  | } | 
| 860 | 14 | 100 |  |  |  | 36 | if ( $key eq 'copyright' ) { | 
| 861 | 2 |  |  |  |  | 9 | $data = "\xE2\x84\x97 " . $data; | 
| 862 |  |  |  |  |  |  | } | 
| 863 | 14 | 100 |  |  |  | 111 | if ( $key eq 'genre' ) { | 
| 864 | 1 |  |  |  |  | 7 | my $gnre = genre_text_to_genre_num($data); | 
| 865 | 1 | 50 |  |  |  | 8 | $data = pack "n", $gnre unless $gnre eq 'INVALID_GENRE'; | 
| 866 |  |  |  |  |  |  | } | 
| 867 | 14 | 100 |  |  |  | 120 | $self->SetMetaInfo( $type, $data, $keep_old ? undef: 1, | 
| 868 |  |  |  |  |  |  | undef, undef ); | 
| 869 |  |  |  |  |  |  | } | 
| 870 |  |  |  |  |  |  | } | 
| 871 | 6 |  |  |  |  | 163 | while ( ( $key, $type ) = each %iTMS_dict_meta_types ) { | 
| 872 | 84 | 100 |  |  |  | 248 | my $meta = $self->FindAtom($type) or next; | 
| 873 | 68 |  |  |  |  | 270 | my $data = substr( $meta->data, 16 ); | 
| 874 | 68 | 100 |  |  |  | 331 | if ( $type eq 'trkn' ) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 875 | 12 |  |  |  |  | 321 | ( undef, $info{trackNumber}, $info{trackCount} ) = unpack "nnn", | 
| 876 |  |  |  |  |  |  | $data; | 
| 877 |  |  |  |  |  |  | } | 
| 878 |  |  |  |  |  |  | elsif ( $type eq 'disk' ) { | 
| 879 | 8 |  |  |  |  | 83 | ( undef, $info{diskNumber}, $info{discCount} ) = unpack "nnn", | 
| 880 |  |  |  |  |  |  | $data; | 
| 881 |  |  |  |  |  |  | } | 
| 882 |  |  |  |  |  |  | elsif ( $type eq 'cprt' ) { | 
| 883 | 4 |  |  |  |  | 34 | ( undef, $info{'copyright'} ) = split( /\s+/, $data, 2 ); | 
| 884 |  |  |  |  |  |  | } | 
| 885 | 44 |  |  |  |  | 359 | else { $info{$key} = $data } | 
| 886 |  |  |  |  |  |  | } | 
| 887 | 6 |  |  |  |  | 72 | return \%info; | 
| 888 |  |  |  |  |  |  | } | 
| 889 |  |  |  |  |  |  |  | 
| 890 |  |  |  |  |  |  |  | 
| 891 |  |  |  |  |  |  | # Get cover art--returns a reference to an array of cover artwork | 
| 892 |  |  |  |  |  |  | sub GetCoverArt { | 
| 893 | 3 |  |  | 3 | 1 | 1050 | my ($self) = @_; | 
| 894 | 3 | 100 |  |  |  | 10 | my @covr = $self->FindAtom('covr') or return; | 
| 895 | 2 |  |  |  |  | 6 | my @artwork = (); | 
| 896 | 2 |  |  |  |  | 113 | foreach my $atm (@covr) { | 
| 897 | 2 | 50 |  |  |  | 12 | my @data_atms = $atm->Contained('data') or next; | 
| 898 | 2 |  |  |  |  | 4 | foreach my $dt ( @data_atms ) { | 
| 899 | 2 |  |  |  |  | 8 | push @artwork, substr( $dt->data, 8 ); | 
| 900 |  |  |  |  |  |  | } | 
| 901 |  |  |  |  |  |  | } | 
| 902 | 2 |  |  |  |  | 16 | return \@artwork; | 
| 903 |  |  |  |  |  |  | } | 
| 904 |  |  |  |  |  |  |  | 
| 905 |  |  |  |  |  |  |  | 
| 906 |  |  |  |  |  |  | # remove all cover art, return number of covers removed | 
| 907 |  |  |  |  |  |  | # does not remove an empty covr atom (one without cover data) | 
| 908 |  |  |  |  |  |  | sub DeleteAllCoverArt { | 
| 909 | 1 |  |  | 1 | 1 | 2 | my ($self) = @_; | 
| 910 | 1 |  |  |  |  | 2 | my $removed = 0; | 
| 911 | 1 |  |  |  |  | 4 | while( my $atm = $self->FindAtom('covr') ) { | 
| 912 | 1 | 50 |  |  |  | 6 | my @atoms = $atm->Contained('data') or next; | 
| 913 | 1 |  |  |  |  | 5 | my $siz  = $atm->size; | 
| 914 | 1 |  |  |  |  | 6 | my $pos  = $atm->start; | 
| 915 | 1 | 50 |  |  |  | 5 | $atm->selfDelete() or return; | 
| 916 | 1 |  |  |  |  | 7 | $self->FixStco( $siz, $pos ); | 
| 917 | 1 |  |  |  |  | 8 | $removed += scalar @atoms; | 
| 918 |  |  |  |  |  |  | } | 
| 919 | 1 |  |  |  |  | 10 | return $removed; | 
| 920 |  |  |  |  |  |  | } | 
| 921 |  |  |  |  |  |  |  | 
| 922 |  |  |  |  |  |  | # add a single album cover by EITHER adding one covr atom | 
| 923 |  |  |  |  |  |  | # OR adding one cover's data to an existing covr atom | 
| 924 |  |  |  |  |  |  | # takes a argument which should be a compatible graphic format binary | 
| 925 |  |  |  |  |  |  | # but does NO checks for compatibility with iTunes' cover art display | 
| 926 |  |  |  |  |  |  | # type OUGHT TO BE 13 for jpeg, 14 for png graphics format, | 
| 927 |  |  |  |  |  |  | # but method DOES NOT CHECK for type except will default to 13 | 
| 928 |  |  |  |  |  |  | # if no type argument provided | 
| 929 |  |  |  |  |  |  | sub AddCoverArt { | 
| 930 | 1 |  |  | 1 | 1 | 4 | my ($self, $art, $type) = @_; | 
| 931 | 1 | 50 |  |  |  | 5 | $type = 13 unless $type; | 
| 932 | 1 |  |  |  |  | 4 | my $covr = $self->FindAtom('covr'); | 
| 933 | 1 | 50 |  |  |  | 6 | if( !$covr ) | 
| 934 |  |  |  |  |  |  | { | 
| 935 | 1 |  | 50 |  |  | 4 | my $ilst = $self->FindAtom('ilst') || $self->MakeIlstAtom || return; | 
| 936 | 1 |  |  |  |  | 6 | $ilst->insertNew( 'covr', '' ); | 
| 937 | 1 |  |  |  |  | 6 | $self->FixStco( -8, $ilst->start ); | 
| 938 | 1 | 50 |  |  |  | 5 | return unless $covr = $self->FindAtom('covr'); | 
| 939 |  |  |  |  |  |  | } | 
| 940 | 1 |  |  |  |  | 24 | $covr->insertNew( 'data', pack( 'NN', $type, 0 ) . $art ); | 
| 941 | 1 |  |  |  |  | 5 | $self->FixStco( -16 - length $art, $covr->start ); | 
| 942 | 1 |  |  |  |  | 5 | return 1; | 
| 943 |  |  |  |  |  |  | } | 
| 944 |  |  |  |  |  |  |  | 
| 945 |  |  |  |  |  |  | #----------------------------------------------------------- | 
| 946 |  |  |  |  |  |  |  | 
| 947 |  |  |  |  |  |  | # MP3::Tag analogs, but more fields, and allow setting of tags | 
| 948 |  |  |  |  |  |  |  | 
| 949 |  |  |  |  |  |  | sub autoinfo { | 
| 950 | 1 |  |  | 1 | 1 | 813 | my ($self) = @_; | 
| 951 | 1 |  |  |  |  | 5 | my $tags = $self->GetMetaInfo; | 
| 952 |  |  |  |  |  |  | return ( | 
| 953 | 1 |  |  |  |  | 10 | $tags->{TITLE},   $tags->{TRKN}, $tags->{ARTIST}, $tags->{ALBUM}, | 
| 954 |  |  |  |  |  |  | $tags->{COMMENT}, $tags->{YEAR}, $tags->{GENRE} | 
| 955 |  |  |  |  |  |  | ); | 
| 956 |  |  |  |  |  |  | } | 
| 957 |  |  |  |  |  |  |  | 
| 958 |  |  |  |  |  |  | sub title { | 
| 959 | 6 |  |  | 6 | 1 | 23 | my ( $self, $new_tag ) = @_; | 
| 960 | 6 | 100 |  |  |  | 63 | $self->SetMetaInfo( 'TITLE', $new_tag, 1 ) if $new_tag; | 
| 961 | 6 |  |  |  |  | 36 | my $tags = $self->GetMetaInfo; | 
| 962 | 6 |  | 100 |  |  | 66 | return $tags->{TITLE} || ''; | 
| 963 |  |  |  |  |  |  | } | 
| 964 |  |  |  |  |  |  |  | 
| 965 |  |  |  |  |  |  | sub album { | 
| 966 | 8 |  |  | 8 | 1 | 807 | my ( $self, $new_tag ) = @_; | 
| 967 | 8 | 100 |  |  |  | 49 | $self->SetMetaInfo( 'ALBUM', $new_tag, 1 ) if $new_tag; | 
| 968 | 8 |  |  |  |  | 185 | my $tags = $self->GetMetaInfo; | 
| 969 | 8 |  | 100 |  |  | 92 | return $tags->{ALBUM} || ''; | 
| 970 |  |  |  |  |  |  | } | 
| 971 |  |  |  |  |  |  |  | 
| 972 |  |  |  |  |  |  | sub artist { | 
| 973 | 5 |  |  | 5 | 1 | 22 | my ( $self, $new_tag ) = @_; | 
| 974 | 5 | 100 |  |  |  | 27 | $self->SetMetaInfo( 'ARTIST', $new_tag, 1 ) if $new_tag; | 
| 975 | 5 |  |  |  |  | 27 | my $tags = $self->GetMetaInfo; | 
| 976 | 5 |  | 100 |  |  | 77 | return $tags->{ARTIST} || ''; | 
| 977 |  |  |  |  |  |  | } | 
| 978 |  |  |  |  |  |  |  | 
| 979 |  |  |  |  |  |  | sub comment { | 
| 980 | 5 |  |  | 5 | 1 | 17 | my ( $self, $new_tag ) = @_; | 
| 981 | 5 | 100 |  |  |  | 27 | $self->SetMetaInfo( 'COMMENT', $new_tag, 1 ) if $new_tag; | 
| 982 | 5 |  |  |  |  | 30 | my $tags = $self->GetMetaInfo; | 
| 983 | 5 |  | 100 |  |  | 67 | return $tags->{COMMENT} || ''; | 
| 984 |  |  |  |  |  |  | } | 
| 985 |  |  |  |  |  |  |  | 
| 986 |  |  |  |  |  |  | sub year { | 
| 987 | 5 |  |  | 5 | 1 | 20 | my ( $self, $new_tag ) = @_; | 
| 988 | 5 | 100 |  |  |  | 29 | $self->SetMetaInfo( 'YEAR', $new_tag, 1 ) if $new_tag; | 
| 989 | 5 |  |  |  |  | 27 | my $tags = $self->GetMetaInfo; | 
| 990 | 5 |  | 100 |  |  | 67 | return $tags->{YEAR} || 0; | 
| 991 |  |  |  |  |  |  | } | 
| 992 |  |  |  |  |  |  |  | 
| 993 |  |  |  |  |  |  | sub genre { | 
| 994 | 7 |  |  | 7 | 1 | 24 | my ( $self, $new_tag ) = @_; | 
| 995 | 7 | 100 |  |  |  | 43 | $self->SetMetaInfo( 'GENRE', pack( "n", $new_tag ), 1 ) if $new_tag; | 
| 996 | 7 |  |  |  |  | 37 | my $tags = $self->GetMetaInfo; | 
| 997 | 7 |  | 100 |  |  | 85 | return $tags->{GENRE} || ''; | 
| 998 |  |  |  |  |  |  | } | 
| 999 |  |  |  |  |  |  |  | 
| 1000 |  |  |  |  |  |  | sub genre_as_text { | 
| 1001 | 2 |  |  | 2 | 1 | 6 | my ( $self, $new_tag ) = @_; | 
| 1002 | 2 |  |  |  |  | 6 | my ( $i, $genre_num ); | 
| 1003 | 2 | 50 |  |  |  | 92 | if ($new_tag) { | 
| 1004 | 0 |  |  |  |  | 0 | $self->genre( genre_text_to_genre_num($new_tag) ); | 
| 1005 |  |  |  |  |  |  | } | 
| 1006 | 2 |  |  |  |  | 11 | return genre_num_to_genre_text( $self->genre ); | 
| 1007 |  |  |  |  |  |  | } | 
| 1008 |  |  |  |  |  |  |  | 
| 1009 |  |  |  |  |  |  | sub track { | 
| 1010 | 1 |  |  | 1 | 1 | 3 | my ( $self, $new_trkn ) = @_; | 
| 1011 | 1 |  |  |  |  | 6 | my $tags = $self->GetMetaInfo(1); | 
| 1012 | 1 | 50 |  |  |  | 8 | if ($new_trkn) { | 
| 1013 | 0 |  | 0 |  |  | 0 | my $tcount = $tags->{TRACKCOUNT} || 0; | 
| 1014 | 0 |  |  |  |  | 0 | $self->SetMetaInfo( 'TRKN', "$new_trkn of $tcount", 1, 0, 1 ); | 
| 1015 | 0 |  |  |  |  | 0 | $tags = $self->GetMetaInfo(1); | 
| 1016 |  |  |  |  |  |  | } | 
| 1017 | 1 |  | 50 |  |  | 16 | return $tags->{TRKN} || 0; | 
| 1018 |  |  |  |  |  |  | } | 
| 1019 |  |  |  |  |  |  |  | 
| 1020 |  |  |  |  |  |  | sub tracks { | 
| 1021 | 4 |  |  | 4 | 1 | 17 | my ( $self, $new_trkn, $new_tcount ) = @_; | 
| 1022 | 4 | 100 | 66 |  |  | 39 | $self->SetMetaInfo( 'TRKN', "$new_trkn of $new_tcount", 1, 0, 1 ) | 
| 1023 |  |  |  |  |  |  | if ( $new_trkn and $new_tcount ); | 
| 1024 | 4 |  |  |  |  | 34 | my $tags   = $self->GetMetaInfo; | 
| 1025 | 4 |  | 50 |  |  | 27 | my $trkn   = $tags->{TRKN} || 0; | 
| 1026 | 4 |  | 50 |  |  | 22 | my $tcount = $tags->{TRACKCOUNT} || 0; | 
| 1027 | 4 |  |  |  |  | 19 | return ( $trkn, $tcount ); | 
| 1028 |  |  |  |  |  |  | } | 
| 1029 |  |  |  |  |  |  |  | 
| 1030 |  |  |  |  |  |  | sub total { | 
| 1031 | 1 |  |  | 1 | 1 | 3 | my ( $self, $new_tcount ) = @_; | 
| 1032 | 1 |  |  |  |  | 2 | my $tags; | 
| 1033 | 1 | 50 |  |  |  | 6 | if ($new_tcount) { | 
| 1034 | 0 |  |  |  |  | 0 | $tags = $self->GetMetaInfo; | 
| 1035 | 0 |  |  |  |  | 0 | $self->SetMetaInfo( 'TRKN', $tags->{TRKN} . " of $new_tcount", 1, 0, | 
| 1036 |  |  |  |  |  |  | 1 ); | 
| 1037 |  |  |  |  |  |  | } | 
| 1038 | 1 |  |  |  |  | 6 | $tags = $self->GetMetaInfo; | 
| 1039 | 1 |  | 50 |  |  | 11 | my $trkn   = $tags->{TRKN}       || 0; | 
| 1040 | 1 |  | 50 |  |  | 8 | my $tcount = $tags->{TRACKCOUNT} || 0; | 
| 1041 | 1 |  |  |  |  | 20 | return $tcount; | 
| 1042 |  |  |  |  |  |  | } | 
| 1043 |  |  |  |  |  |  |  | 
| 1044 |  |  |  |  |  |  | sub all_tags { | 
| 1045 | 1 |  |  | 1 | 1 | 4 | my ( $self, $tags_href ) = @_; | 
| 1046 | 1 | 50 |  |  |  | 5 | if ( ref $tags_href ) { | 
| 1047 | 1 | 50 |  |  |  | 10 | $self->title( $tags_href->{title} )     if $tags_href->{title}; | 
| 1048 | 1 | 50 |  |  |  | 7 | $self->artist( $tags_href->{artist} )   if $tags_href->{artist}; | 
| 1049 | 1 | 50 |  |  |  | 11 | $self->album( $tags_href->{album} )     if $tags_href->{album}; | 
| 1050 | 1 | 50 |  |  |  | 9 | $self->comment( $tags_href->{comment} ) if $tags_href->{comment}; | 
| 1051 | 1 | 50 |  |  |  | 6 | $self->genre( $tags_href->{genre} )     if $tags_href->{genre}; | 
| 1052 | 1 | 50 |  |  |  | 4 | $self->year( $tags_href->{year} )       if $tags_href->{year}; | 
| 1053 | 1 | 50 |  |  |  | 5 | $self->track( $tags_href->{track} )     if $tags_href->{track}; | 
| 1054 | 1 | 50 |  |  |  | 5 | $self->total( $tags_href->{total} )     if $tags_href->{total}; | 
| 1055 |  |  |  |  |  |  | } | 
| 1056 |  |  |  |  |  |  | return { | 
| 1057 | 1 |  |  |  |  | 4 | title   => $self->title(), | 
| 1058 |  |  |  |  |  |  | artist  => $self->artist(), | 
| 1059 |  |  |  |  |  |  | album   => $self->album(), | 
| 1060 |  |  |  |  |  |  | comment => $self->comment(), | 
| 1061 |  |  |  |  |  |  | genre   => $self->genre(), | 
| 1062 |  |  |  |  |  |  | year    => $self->year(), | 
| 1063 |  |  |  |  |  |  | track   => $self->track(), | 
| 1064 |  |  |  |  |  |  | total   => $self->total(), | 
| 1065 |  |  |  |  |  |  | }; | 
| 1066 |  |  |  |  |  |  | } | 
| 1067 |  |  |  |  |  |  |  | 
| 1068 |  |  |  |  |  |  | #------------ other compatibility functions with Audio::TagLib -----------------# | 
| 1069 |  |  |  |  |  |  |  | 
| 1070 | 0 |  |  | 0 | 1 | 0 | sub setTitle   { title(@_) } | 
| 1071 | 0 |  |  | 0 | 1 | 0 | sub setArtist  { artist(@_) } | 
| 1072 | 0 |  |  | 0 | 1 | 0 | sub setAlbum   { album(@_) } | 
| 1073 | 0 |  |  | 0 | 1 | 0 | sub setComment { comment(@_) } | 
| 1074 | 0 |  |  | 0 | 1 | 0 | sub setGenre   { genre(@_) } | 
| 1075 | 0 |  |  | 0 | 1 | 0 | sub setTrack   { track(@_) } | 
| 1076 | 0 |  |  | 0 | 1 | 0 | sub setTracks  { tracks(@_) } | 
| 1077 | 0 |  |  | 0 | 1 | 0 | sub setTotal   { total(@_) } | 
| 1078 |  |  |  |  |  |  |  | 
| 1079 |  |  |  |  |  |  | #-------------- non-self helper functions --------------------------# | 
| 1080 |  |  |  |  |  |  |  | 
| 1081 |  |  |  |  |  |  | sub isMetaDataType { | 
| 1082 | 0 |  |  | 0 | 1 | 0 | return $meta_info_types{shift}; | 
| 1083 |  |  |  |  |  |  | } | 
| 1084 |  |  |  |  |  |  |  | 
| 1085 |  |  |  |  |  |  | sub genre_text_to_genre_num { | 
| 1086 | 1 |  |  | 1 | 1 | 3 | my $text = shift; | 
| 1087 | 1 |  |  |  |  | 7 | return $genre_text_to_genre_numbers{$text}; | 
| 1088 |  |  |  |  |  |  | } | 
| 1089 |  |  |  |  |  |  |  | 
| 1090 |  |  |  |  |  |  | sub genre_num_to_genre_text { | 
| 1091 | 2 |  |  | 2 | 1 | 6 | my $num = shift; | 
| 1092 | 2 |  |  |  |  | 25 | return $genre_numbers_to_genre_text{$num}; | 
| 1093 |  |  |  |  |  |  | } | 
| 1094 |  |  |  |  |  |  |  | 
| 1095 |  |  |  |  |  |  | sub asset_language_pack_iso_639_2T { | 
| 1096 | 3 |  |  | 3 | 1 | 5 | my ($lang3chars) = @_; | 
| 1097 | 9 | 50 |  |  |  | 30 | my ( $c1, $c2, $c3 ) = | 
| 1098 | 3 |  |  |  |  | 18 | map { $_ ? ord($_) - 60 : 0 } split( //, $lang3chars ); | 
| 1099 | 3 |  |  |  |  | 16 | return ( $c1 * ( 2**10 ) ) + ( $c2 * ( 2**5 ) ) + $c3; | 
| 1100 |  |  |  |  |  |  | } | 
| 1101 |  |  |  |  |  |  |  | 
| 1102 |  |  |  |  |  |  | =head1 NAME | 
| 1103 |  |  |  |  |  |  |  | 
| 1104 |  |  |  |  |  |  | Audio::M4P::QuickTime -- Perl M4P/MP4/M4a audio / video tools | 
| 1105 |  |  |  |  |  |  |  | 
| 1106 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 1107 |  |  |  |  |  |  |  | 
| 1108 |  |  |  |  |  |  | Perl manipulation of Quicktime Audio files, including protected audio M4P | 
| 1109 |  |  |  |  |  |  | files. Allows extraction and modification of meta information in Apple | 
| 1110 |  |  |  |  |  |  | QuickTime AAC/m4a music files. | 
| 1111 |  |  |  |  |  |  |  | 
| 1112 |  |  |  |  |  |  | =head2 About QuickTime File Structure and Atoms | 
| 1113 |  |  |  |  |  |  |  | 
| 1114 |  |  |  |  |  |  | M4P is a QuickTime protected audio file format. It is composed of a linear | 
| 1115 |  |  |  |  |  |  | stream of bytes which are segmented into units called atoms. Some atoms | 
| 1116 |  |  |  |  |  |  | may be containers for other atoms. iTunes Music Store M4P music files are | 
| 1117 |  |  |  |  |  |  | Quicktime audio files which are encrypted using a combination of information | 
| 1118 |  |  |  |  |  |  | in the file's drms atom and information which is commonly stored on the | 
| 1119 |  |  |  |  |  |  | computer or audio player. | 
| 1120 |  |  |  |  |  |  |  | 
| 1121 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 1122 |  |  |  |  |  |  |  | 
| 1123 |  |  |  |  |  |  | =over 4 | 
| 1124 |  |  |  |  |  |  |  | 
| 1125 |  |  |  |  |  |  | use Audio::M4P::QuickTime; | 
| 1126 |  |  |  |  |  |  |  | 
| 1127 |  |  |  |  |  |  | my $mp4file = "file.m4p"; | 
| 1128 |  |  |  |  |  |  |  | 
| 1129 |  |  |  |  |  |  | my $qt = new Audio::M4P::QuickTime(file => $mp4file); | 
| 1130 |  |  |  |  |  |  |  | 
| 1131 |  |  |  |  |  |  | my $tags = $qt->GetMetaInfo; | 
| 1132 |  |  |  |  |  |  |  | 
| 1133 |  |  |  |  |  |  | print "Artist is $tags->{ARTIST}\n" if $tags->{ARTIST}; | 
| 1134 |  |  |  |  |  |  |  | 
| 1135 |  |  |  |  |  |  | =back | 
| 1136 |  |  |  |  |  |  |  | 
| 1137 |  |  |  |  |  |  | =head1 METHODS | 
| 1138 |  |  |  |  |  |  |  | 
| 1139 |  |  |  |  |  |  | =head2 Object Methods | 
| 1140 |  |  |  |  |  |  |  | 
| 1141 |  |  |  |  |  |  | =over 4 | 
| 1142 |  |  |  |  |  |  |  | 
| 1143 |  |  |  |  |  |  | =item B | 
| 1144 |  |  |  |  |  |  |  | 
| 1145 |  |  |  |  |  |  | my $qt = Audio::M4P::QuickTime->new; | 
| 1146 |  |  |  |  |  |  |  | 
| 1147 |  |  |  |  |  |  | $qt = new Audio::M4P::QuickTime( | 
| 1148 |  |  |  |  |  |  | DEBUG => 2, | 
| 1149 |  |  |  |  |  |  | DEBUGDUMPFILE => 'quicktime_treedump.html' | 
| 1150 |  |  |  |  |  |  | ); | 
| 1151 |  |  |  |  |  |  |  | 
| 1152 |  |  |  |  |  |  | $qt = new Audio::M4P::QuickTime(file => 'qt_audio_file.m4p'); | 
| 1153 |  |  |  |  |  |  |  | 
| 1154 |  |  |  |  |  |  | Create a new Audio::M4P::QuickTime object. DEBUG => 1 as argument causes | 
| 1155 |  |  |  |  |  |  | parse and other information to be printed to stdout during processing. | 
| 1156 |  |  |  |  |  |  | DEBUG => 2, DEBUGDUMPFILE => "file" causes an HTML tree representation | 
| 1157 |  |  |  |  |  |  | of the QuickTime file to be emitted to the file given as value to the | 
| 1158 |  |  |  |  |  |  | argument pair. file => "filename.m4p" causes the named QuickTime file to | 
| 1159 |  |  |  |  |  |  | be read and parsed during object initialization. | 
| 1160 |  |  |  |  |  |  |  | 
| 1161 |  |  |  |  |  |  | =item B | 
| 1162 |  |  |  |  |  |  |  | 
| 1163 |  |  |  |  |  |  | $qt->ReadFile("filename.m4a"); | 
| 1164 |  |  |  |  |  |  |  | 
| 1165 |  |  |  |  |  |  | Read the named file into the QuickTime object buffer. | 
| 1166 |  |  |  |  |  |  |  | 
| 1167 |  |  |  |  |  |  | =item B | 
| 1168 |  |  |  |  |  |  |  | 
| 1169 |  |  |  |  |  |  | $qt->ParseBuffer; | 
| 1170 |  |  |  |  |  |  |  | 
| 1171 |  |  |  |  |  |  | Parse the file that has been read as a QuickTime stream. | 
| 1172 |  |  |  |  |  |  |  | 
| 1173 |  |  |  |  |  |  | =item B | 
| 1174 |  |  |  |  |  |  |  | 
| 1175 |  |  |  |  |  |  | $qt->WriteFile("ouput.m4p"); | 
| 1176 |  |  |  |  |  |  |  | 
| 1177 |  |  |  |  |  |  | Write the (possibly modified) file back to the output file argument. | 
| 1178 |  |  |  |  |  |  |  | 
| 1179 |  |  |  |  |  |  | =item B | 
| 1180 |  |  |  |  |  |  |  | 
| 1181 |  |  |  |  |  |  | my $hashref = $qt->GetMetaInfo(1); | 
| 1182 |  |  |  |  |  |  | while(my($tag, $value) = each %{$hashref}) { | 
| 1183 |  |  |  |  |  |  | print "$tag => $value\n"; | 
| 1184 |  |  |  |  |  |  | } | 
| 1185 |  |  |  |  |  |  |  | 
| 1186 |  |  |  |  |  |  | Returns a hash reference to meta tag information. Attempts to be compatible | 
| 1187 |  |  |  |  |  |  | with tag information formats in MP3::Info and MP4::Info. Potential tags are | 
| 1188 |  |  |  |  |  |  | AAID, ALBUM, ARTIST, COMMENT, COM, CPIL, CPRT, YEAR, DISK, GENRE, GRP, NAM, | 
| 1189 |  |  |  |  |  |  | RTNG, TMPO, TOO, TRKN, and WRT. Note that, due to preservation of compatibility | 
| 1190 |  |  |  |  |  |  | with MP3::Info by returning tag info as a hash reference, duplicate entries of | 
| 1191 |  |  |  |  |  |  | the same tag name, such as multiple comment fields, will not be returned in the hash | 
| 1192 |  |  |  |  |  |  | reference. An optional second argument, if 1 or true, should convert some | 
| 1193 |  |  |  |  |  |  | binary fields to text in the tags, for instance | 
| 1194 |  |  |  |  |  |  | my $hashref = $qt->GetMetaInfo(1); | 
| 1195 |  |  |  |  |  |  |  | 
| 1196 |  |  |  |  |  |  | =item B | 
| 1197 |  |  |  |  |  |  |  | 
| 1198 |  |  |  |  |  |  | my $hashref = $qt->GetMP4Info; | 
| 1199 |  |  |  |  |  |  | while(my($tag, $value) = each %{$hashref}) { | 
| 1200 |  |  |  |  |  |  | print "$tag => $value\n"; | 
| 1201 |  |  |  |  |  |  | } | 
| 1202 |  |  |  |  |  |  |  | 
| 1203 |  |  |  |  |  |  | Returns a hash reference to MP3 tag audio information. Attempts to be compatible | 
| 1204 |  |  |  |  |  |  | with tag information formats in MP3::Info and MP4::Info. Potential tags are | 
| 1205 |  |  |  |  |  |  | LAYER (1), VERSION (4), SIZE, SECONDS, SS, MM, and BITRATE. | 
| 1206 |  |  |  |  |  |  |  | 
| 1207 |  |  |  |  |  |  | =item B | 
| 1208 |  |  |  |  |  |  |  | 
| 1209 |  |  |  |  |  |  | my $comment = "After paying for this music file, I have fair use rights to change it."; | 
| 1210 |  |  |  |  |  |  |  | 
| 1211 |  |  |  |  |  |  | $qt->SetMetaInfo(COMMENT => $comment); | 
| 1212 |  |  |  |  |  |  | $qt->SetMetaInfo(GENRE => "Bebop", 1, 'day'); | 
| 1213 |  |  |  |  |  |  |  | 
| 1214 |  |  |  |  |  |  | Set a meta information field. The third argument, if given and true, indicates | 
| 1215 |  |  |  |  |  |  | that the program should replace all instances of meta data of this type with | 
| 1216 |  |  |  |  |  |  | the new entry, rather than adding the tag to the existing meta data. The fourth | 
| 1217 |  |  |  |  |  |  | argument, if given and true, indicated a tag value before which the new tag is | 
| 1218 |  |  |  |  |  |  | to be placed in the file. The fifth argument indicates the values are in text | 
| 1219 |  |  |  |  |  |  | form, ie for meta type 'trkn', value is something like 'Track 5 of 11'. | 
| 1220 |  |  |  |  |  |  |  | 
| 1221 |  |  |  |  |  |  | =item B | 
| 1222 |  |  |  |  |  |  |  | 
| 1223 |  |  |  |  |  |  | my $hashref = $qt->iTMS_MetaInfo; | 
| 1224 |  |  |  |  |  |  |  | 
| 1225 |  |  |  |  |  |  | $hashref->{comments} = "A new comment"; | 
| 1226 |  |  |  |  |  |  | $qt->iTMS_MetaInfo($hashref); | 
| 1227 |  |  |  |  |  |  |  | 
| 1228 |  |  |  |  |  |  | Get or set a meta information field via a hash reference to an Apple iTMS | 
| 1229 |  |  |  |  |  |  | type dict data structure. Possible fields are copyright, comments, | 
| 1230 |  |  |  |  |  |  | songName, genre, playlistArtistName, genreID, composerName, playlistName, | 
| 1231 |  |  |  |  |  |  | year, trackNumber, trackCount, discNumber, discCount, and artworkURL. iTMS | 
| 1232 |  |  |  |  |  |  | meta data entries may not be compatible with MP3::Info type meta data. An | 
| 1233 |  |  |  |  |  |  | optional second argument, if true, prevents the method from replacing old meta | 
| 1234 |  |  |  |  |  |  | information, as in $qt->iTMS_MetaInfo($hashref, 1); | 
| 1235 |  |  |  |  |  |  |  | 
| 1236 |  |  |  |  |  |  | Note that although this method of manipulating M4P data tags is closest to the | 
| 1237 |  |  |  |  |  |  | way iTMS and iTunes do metadata, it may be less intuitive for most audio tag | 
| 1238 |  |  |  |  |  |  | programmers than the MP3::Tag and Audio::TagLib compatible methods below. | 
| 1239 |  |  |  |  |  |  |  | 
| 1240 |  |  |  |  |  |  | =item B | 
| 1241 |  |  |  |  |  |  |  | 
| 1242 |  |  |  |  |  |  | my $artwork = $qt->GetCoverArt(); | 
| 1243 |  |  |  |  |  |  | foreach my $pic (@{$artwork}) { | 
| 1244 |  |  |  |  |  |  | # do stuff with art | 
| 1245 |  |  |  |  |  |  | } | 
| 1246 |  |  |  |  |  |  |  | 
| 1247 |  |  |  |  |  |  | Returns a reference to an array of cover artwork. Note: the artwork routines | 
| 1248 |  |  |  |  |  |  | were suggested and largely contributed by pucklock. (Thanks!) | 
| 1249 |  |  |  |  |  |  |  | 
| 1250 |  |  |  |  |  |  |  | 
| 1251 |  |  |  |  |  |  | =item B | 
| 1252 |  |  |  |  |  |  |  | 
| 1253 |  |  |  |  |  |  | $qt->DeleteAllCoverArt; | 
| 1254 |  |  |  |  |  |  |  | 
| 1255 |  |  |  |  |  |  | Delete all cover art from the file. This removes all data from the covr atom, | 
| 1256 |  |  |  |  |  |  | if any.  Returns the number of cover data atoms deleted. | 
| 1257 |  |  |  |  |  |  |  | 
| 1258 |  |  |  |  |  |  |  | 
| 1259 |  |  |  |  |  |  | =item B | 
| 1260 |  |  |  |  |  |  |  | 
| 1261 |  |  |  |  |  |  |  | 
| 1262 |  |  |  |  |  |  | $qt->AddCoverArt( $jpeg_art, 13 );  # $jpeg_art is an iTunes compatible jpeg | 
| 1263 |  |  |  |  |  |  | $qt->AddCoverArt( $jpeg_art );      # the same as above, defaults to type 13 | 
| 1264 |  |  |  |  |  |  | $qt->AddCoverArt( $png_art, 14 );   # PNG graphics are data type 14 | 
| 1265 |  |  |  |  |  |  |  | 
| 1266 |  |  |  |  |  |  | Add cover artwork to the file. Creates a new covr atom if needed. Returns 1 if | 
| 1267 |  |  |  |  |  |  | successful, otherwise null. | 
| 1268 |  |  |  |  |  |  |  | 
| 1269 |  |  |  |  |  |  | The method adds a single album cover by either adding one covr atom or | 
| 1270 |  |  |  |  |  |  | by adding one cover's data to an existing covr atom. Takes a argument which | 
| 1271 |  |  |  |  |  |  | should be a compatible graphic format binary, but does NO checks for | 
| 1272 |  |  |  |  |  |  | compatibility with iTunes' cover art display. The type should be 13 | 
| 1273 |  |  |  |  |  |  | for jpeg, 14 for png graphics format, but defaults to 13. | 
| 1274 |  |  |  |  |  |  |  | 
| 1275 |  |  |  |  |  |  |  | 
| 1276 |  |  |  |  |  |  | =back | 
| 1277 |  |  |  |  |  |  |  | 
| 1278 |  |  |  |  |  |  | =head2 MP3::Tag and Audio::TagLib Compatible Functions | 
| 1279 |  |  |  |  |  |  |  | 
| 1280 |  |  |  |  |  |  | =over 4 | 
| 1281 |  |  |  |  |  |  |  | 
| 1282 |  |  |  |  |  |  | =item B | 
| 1283 |  |  |  |  |  |  |  | 
| 1284 |  |  |  |  |  |  | my($title, $tracknum, $artist, $album, $comment, $year, $genre) = | 
| 1285 |  |  |  |  |  |  | $qt->autoinfo; | 
| 1286 |  |  |  |  |  |  |  | 
| 1287 |  |  |  |  |  |  | Returns an array of tag metadata, similar to the same method in MP3::Tag. | 
| 1288 |  |  |  |  |  |  |  | 
| 1289 |  |  |  |  |  |  | =item B | 
| 1290 |  |  |  |  |  |  |  | 
| 1291 |  |  |  |  |  |  | my $album = $qt->album; | 
| 1292 |  |  |  |  |  |  | $new_album = "My New Album Name"; | 
| 1293 |  |  |  |  |  |  | $qt->album($new_album); | 
| 1294 |  |  |  |  |  |  |  | 
| 1295 |  |  |  |  |  |  | Get and set title tag data. | 
| 1296 |  |  |  |  |  |  | Similar to the same method in MP3::TagLib. | 
| 1297 |  |  |  |  |  |  |  | 
| 1298 |  |  |  |  |  |  | Note this and other tag functions below will usually return the empty | 
| 1299 |  |  |  |  |  |  | string "" when there is tag data lacking, unless an integer result is expected, | 
| 1300 |  |  |  |  |  |  | in which case 0 is returned. This is for compatibility with MP3::Tag and | 
| 1301 |  |  |  |  |  |  | Audio::TagLib's implementation of these methods. | 
| 1302 |  |  |  |  |  |  |  | 
| 1303 |  |  |  |  |  |  | =item B | 
| 1304 |  |  |  |  |  |  |  | 
| 1305 |  |  |  |  |  |  | my $artist = $qt->artist; | 
| 1306 |  |  |  |  |  |  | $new_artist = "My New Artist"; | 
| 1307 |  |  |  |  |  |  | $qt->artist($new_artist); | 
| 1308 |  |  |  |  |  |  |  | 
| 1309 |  |  |  |  |  |  | Get and set artist tag data. | 
| 1310 |  |  |  |  |  |  | Similar to the same method in MP3::TagLib. | 
| 1311 |  |  |  |  |  |  |  | 
| 1312 |  |  |  |  |  |  | =item B | 
| 1313 |  |  |  |  |  |  |  | 
| 1314 |  |  |  |  |  |  | my $comment = $qt->comment; | 
| 1315 |  |  |  |  |  |  | $new_comment = "My Comment Goes Here"; | 
| 1316 |  |  |  |  |  |  | $qt->comment($new_comment); | 
| 1317 |  |  |  |  |  |  |  | 
| 1318 |  |  |  |  |  |  | Get and set comment tag data. | 
| 1319 |  |  |  |  |  |  | Similar to the same method in MP3::Tag. | 
| 1320 |  |  |  |  |  |  |  | 
| 1321 |  |  |  |  |  |  | =item B | 
| 1322 |  |  |  |  |  |  |  | 
| 1323 |  |  |  |  |  |  | my $genre = $qt->genre; | 
| 1324 |  |  |  |  |  |  | $new_genre = 18; | 
| 1325 |  |  |  |  |  |  | $qt->genre($new_genre); | 
| 1326 |  |  |  |  |  |  |  | 
| 1327 |  |  |  |  |  |  | Get and set genre tag data BY NUMBER. | 
| 1328 |  |  |  |  |  |  |  | 
| 1329 |  |  |  |  |  |  | =item B | 
| 1330 |  |  |  |  |  |  |  | 
| 1331 |  |  |  |  |  |  | my $text_genre = $qt->genre_as_text; | 
| 1332 |  |  |  |  |  |  | $new_genre = "Rock"; | 
| 1333 |  |  |  |  |  |  | $qt->genre_as_text($new_genre); | 
| 1334 |  |  |  |  |  |  |  | 
| 1335 |  |  |  |  |  |  | Get and set genre tag data as text. Note that the given text tag must exist | 
| 1336 |  |  |  |  |  |  | in the genre database to work. See the "our @genre_strings" object in the | 
| 1337 |  |  |  |  |  |  | code, which can be imported by the declaration "our @genre_strings;" | 
| 1338 |  |  |  |  |  |  | in code using the module. | 
| 1339 |  |  |  |  |  |  |  | 
| 1340 |  |  |  |  |  |  | =item B | 
| 1341 |  |  |  |  |  |  |  | 
| 1342 |  |  |  |  |  |  | my $title = $qt->title; | 
| 1343 |  |  |  |  |  |  | $new_title = "My New One"; | 
| 1344 |  |  |  |  |  |  | $qt->title($new_title); | 
| 1345 |  |  |  |  |  |  |  | 
| 1346 |  |  |  |  |  |  | Get and set title tag data. | 
| 1347 |  |  |  |  |  |  | Similar to the same method in MP3::Tag. | 
| 1348 |  |  |  |  |  |  |  | 
| 1349 |  |  |  |  |  |  | =item B | 
| 1350 |  |  |  |  |  |  |  | 
| 1351 |  |  |  |  |  |  | my $track = $qt->track; | 
| 1352 |  |  |  |  |  |  | my $new_track = 3; | 
| 1353 |  |  |  |  |  |  | $qt->track($new_track); | 
| 1354 |  |  |  |  |  |  |  | 
| 1355 |  |  |  |  |  |  | Get or set the track number. | 
| 1356 |  |  |  |  |  |  |  | 
| 1357 |  |  |  |  |  |  | =item B | 
| 1358 |  |  |  |  |  |  |  | 
| 1359 |  |  |  |  |  |  | my ($track, $count) = $qt->tracks; | 
| 1360 |  |  |  |  |  |  | my $new_track_number = 3; | 
| 1361 |  |  |  |  |  |  | my $total_tracks_on_CD = 17; | 
| 1362 |  |  |  |  |  |  | $qt->tracks($new_track_number, $total_tracks_on_CD); | 
| 1363 |  |  |  |  |  |  |  | 
| 1364 |  |  |  |  |  |  | Get or set both the track number and the total tracks on the originating media | 
| 1365 |  |  |  |  |  |  | work. Not actually an MP3::Tag method, but MP4 files, unlike many MP3 files, | 
| 1366 |  |  |  |  |  |  | regularly contain both track number and the total originating CD's track count. | 
| 1367 |  |  |  |  |  |  |  | 
| 1368 |  |  |  |  |  |  | =item B | 
| 1369 |  |  |  |  |  |  |  | 
| 1370 |  |  |  |  |  |  | my $total = $qt->total; | 
| 1371 |  |  |  |  |  |  | my $new_total = 15; | 
| 1372 |  |  |  |  |  |  | $qt->total($new_total); | 
| 1373 |  |  |  |  |  |  |  | 
| 1374 |  |  |  |  |  |  | Get or set the track total number. | 
| 1375 |  |  |  |  |  |  |  | 
| 1376 |  |  |  |  |  |  | =item B | 
| 1377 |  |  |  |  |  |  |  | 
| 1378 |  |  |  |  |  |  | my $year = $qt->year; | 
| 1379 |  |  |  |  |  |  | $new_year = "My New One"; | 
| 1380 |  |  |  |  |  |  | $qt->year($new_year); | 
| 1381 |  |  |  |  |  |  |  | 
| 1382 |  |  |  |  |  |  | Get and set year tag data. | 
| 1383 |  |  |  |  |  |  | Similar to the same method in MP3::Tag. | 
| 1384 |  |  |  |  |  |  |  | 
| 1385 |  |  |  |  |  |  | =item B | 
| 1386 |  |  |  |  |  |  |  | 
| 1387 |  |  |  |  |  |  | my $tref = $qt->all_tags( album => "My new album", genre => 21 ); | 
| 1388 |  |  |  |  |  |  | print $tref->{artist}; | 
| 1389 |  |  |  |  |  |  |  | 
| 1390 |  |  |  |  |  |  | Similar to the Audio::File::Tag B method. Set or get all the above tags. | 
| 1391 |  |  |  |  |  |  | To set the tags pass a hash reference with the names of the tags as keys and | 
| 1392 |  |  |  |  |  |  | the tag values as hash values. Returns a hash reference if no argument is | 
| 1393 |  |  |  |  |  |  | specified. | 
| 1394 |  |  |  |  |  |  |  | 
| 1395 |  |  |  |  |  |  | The following tag names are supported by this method: | 
| 1396 |  |  |  |  |  |  | album | 
| 1397 |  |  |  |  |  |  | artist | 
| 1398 |  |  |  |  |  |  | comment | 
| 1399 |  |  |  |  |  |  | genre   ( the integer value genre ) | 
| 1400 |  |  |  |  |  |  | title | 
| 1401 |  |  |  |  |  |  | track | 
| 1402 |  |  |  |  |  |  | total | 
| 1403 |  |  |  |  |  |  |  | 
| 1404 |  |  |  |  |  |  | =back | 
| 1405 |  |  |  |  |  |  |  | 
| 1406 |  |  |  |  |  |  | =head2 Other Audio::TagLib syntactic compatibility | 
| 1407 |  |  |  |  |  |  |  | 
| 1408 |  |  |  |  |  |  | =over 4 | 
| 1409 |  |  |  |  |  |  |  | 
| 1410 |  |  |  |  |  |  | =item The following 'set' methods are equivalent to methods above used with an argument. They are included in this module for Audio::TagLib compatibility: | 
| 1411 |  |  |  |  |  |  |  | 
| 1412 |  |  |  |  |  |  | =item Method     equivalent to | 
| 1413 |  |  |  |  |  |  |  | 
| 1414 |  |  |  |  |  |  | =item ------------------------ | 
| 1415 |  |  |  |  |  |  |  | 
| 1416 |  |  |  |  |  |  | =item setAlbum     album | 
| 1417 |  |  |  |  |  |  |  | 
| 1418 |  |  |  |  |  |  | =item setArtist    artist | 
| 1419 |  |  |  |  |  |  |  | 
| 1420 |  |  |  |  |  |  | =item setTitle     title | 
| 1421 |  |  |  |  |  |  |  | 
| 1422 |  |  |  |  |  |  | =item setComment   comment | 
| 1423 |  |  |  |  |  |  |  | 
| 1424 |  |  |  |  |  |  | =item setGenre     genre | 
| 1425 |  |  |  |  |  |  |  | 
| 1426 |  |  |  |  |  |  | =item setTrack     track | 
| 1427 |  |  |  |  |  |  |  | 
| 1428 |  |  |  |  |  |  | =item setTracks    tracks | 
| 1429 |  |  |  |  |  |  |  | 
| 1430 |  |  |  |  |  |  | =item setTotal     total tracks | 
| 1431 |  |  |  |  |  |  |  | 
| 1432 |  |  |  |  |  |  | =back | 
| 1433 |  |  |  |  |  |  |  | 
| 1434 |  |  |  |  |  |  | =head2 Apple m4a personal data removal function | 
| 1435 |  |  |  |  |  |  |  | 
| 1436 |  |  |  |  |  |  | =over 4 | 
| 1437 |  |  |  |  |  |  |  | 
| 1438 |  |  |  |  |  |  | =item B | 
| 1439 |  |  |  |  |  |  |  | 
| 1440 |  |  |  |  |  |  | my $file_name = "mp4aIDfile.m4a"; | 
| 1441 |  |  |  |  |  |  | my $qt = Audio::M4P::QuickTime->new(file => $file_name); | 
| 1442 |  |  |  |  |  |  | $qt->CleanAppleM4aPersonalData(); | 
| 1443 |  |  |  |  |  |  | $qt->WriteFile('cleaned' . $file_name); | 
| 1444 |  |  |  |  |  |  |  | 
| 1445 |  |  |  |  |  |  | ...OR... | 
| 1446 |  |  |  |  |  |  |  | 
| 1447 |  |  |  |  |  |  | #!/usr/bin/perl | 
| 1448 |  |  |  |  |  |  |  | 
| 1449 |  |  |  |  |  |  | use Tk; | 
| 1450 |  |  |  |  |  |  | use Cwd; | 
| 1451 |  |  |  |  |  |  | use strict; | 
| 1452 |  |  |  |  |  |  | use warnings; | 
| 1453 |  |  |  |  |  |  | use Audio::M4P::QuickTime; | 
| 1454 |  |  |  |  |  |  |  | 
| 1455 |  |  |  |  |  |  | my $backup_requested = "yes"; | 
| 1456 |  |  |  |  |  |  |  | 
| 1457 |  |  |  |  |  |  | my $win = new MainWindow; | 
| 1458 |  |  |  |  |  |  | my $frm = $win->Frame()->pack; | 
| 1459 |  |  |  |  |  |  | $frm->Label( | 
| 1460 |  |  |  |  |  |  | -text => "Anonymize Apple iTunes Plus .m4a Files", | 
| 1461 |  |  |  |  |  |  | -font => "Garamond 20 bold", | 
| 1462 |  |  |  |  |  |  | )->pack; | 
| 1463 |  |  |  |  |  |  |  | 
| 1464 |  |  |  |  |  |  | my $do_backup_choice = $frm->Radiobutton( | 
| 1465 |  |  |  |  |  |  | -text  => "Back Up (append .old.m4a to old files)", | 
| 1466 |  |  |  |  |  |  | -value => 'yes', | 
| 1467 |  |  |  |  |  |  | -variable => \$backup_requested, | 
| 1468 |  |  |  |  |  |  | -font => "Garamond 14 bold", | 
| 1469 |  |  |  |  |  |  | )->pack; | 
| 1470 |  |  |  |  |  |  |  | 
| 1471 |  |  |  |  |  |  | my $do_no_backup_choice = $frm->Radiobutton( | 
| 1472 |  |  |  |  |  |  | -text     => "Do Not Back Up (files will be over-written!)", | 
| 1473 |  |  |  |  |  |  | -value    => 'no', | 
| 1474 |  |  |  |  |  |  | -variable => \$backup_requested, | 
| 1475 |  |  |  |  |  |  | -font => "Garamond 14 bold", | 
| 1476 |  |  |  |  |  |  | )->pack; | 
| 1477 |  |  |  |  |  |  |  | 
| 1478 |  |  |  |  |  |  | my $convert_button = $win->Button( | 
| 1479 |  |  |  |  |  |  | -text    => "Convert Files", | 
| 1480 |  |  |  |  |  |  | -command => \&push_button, | 
| 1481 |  |  |  |  |  |  | -font => "Garamond 17 bold", | 
| 1482 |  |  |  |  |  |  | )->pack; | 
| 1483 |  |  |  |  |  |  |  | 
| 1484 |  |  |  |  |  |  | my $exit_button = $win->Button( | 
| 1485 |  |  |  |  |  |  | -text    => "Exit", | 
| 1486 |  |  |  |  |  |  | -command => sub { exit 0 }, | 
| 1487 |  |  |  |  |  |  | -font => "Garamond 17 bold", | 
| 1488 |  |  |  |  |  |  | )->pack; | 
| 1489 |  |  |  |  |  |  |  | 
| 1490 |  |  |  |  |  |  | MainLoop; | 
| 1491 |  |  |  |  |  |  |  | 
| 1492 |  |  |  |  |  |  | sub push_button { | 
| 1493 |  |  |  |  |  |  | my $write_extension = $backup_requested eq 'no' ? '' : '.old.m4a'; | 
| 1494 |  |  |  |  |  |  | my @file_list = $win->getOpenFile( | 
| 1495 |  |  |  |  |  |  | -defaultextension => ".pl", | 
| 1496 |  |  |  |  |  |  | -filetypes        => [ [ 'MP4a files', '.m4a', ], [ 'All Files', '*', ], ], | 
| 1497 |  |  |  |  |  |  | -initialdir       => Cwd::cwd(), | 
| 1498 |  |  |  |  |  |  | -initialfile      => "getopenfile", | 
| 1499 |  |  |  |  |  |  | -title    => "Choose Purchased Apple iTunes Plus Files to Anonymize", | 
| 1500 |  |  |  |  |  |  | -multiple => 1, | 
| 1501 |  |  |  |  |  |  | ); | 
| 1502 |  |  |  |  |  |  |  | 
| 1503 |  |  |  |  |  |  | foreach my $filename (@file_list) { | 
| 1504 |  |  |  |  |  |  | my $qt = Audio::M4P::QuickTime->new( file => $filename ); | 
| 1505 |  |  |  |  |  |  | if ( $qt->FindAtom("mp4a") ) { | 
| 1506 |  |  |  |  |  |  | $qt->CleanAppleM4aPersonalData(); | 
| 1507 |  |  |  |  |  |  | rename( $filename, $filename . $write_extension ); | 
| 1508 |  |  |  |  |  |  | $qt->WriteFile($filename); | 
| 1509 |  |  |  |  |  |  | } | 
| 1510 |  |  |  |  |  |  | else { | 
| 1511 |  |  |  |  |  |  | $win->messageBox( | 
| 1512 |  |  |  |  |  |  | -message => "Error: $filename is not a valid m4a file.", | 
| 1513 |  |  |  |  |  |  | -type    => 'ok', | 
| 1514 |  |  |  |  |  |  | -icon    => 'error' | 
| 1515 |  |  |  |  |  |  | ); | 
| 1516 |  |  |  |  |  |  | } | 
| 1517 |  |  |  |  |  |  | } | 
| 1518 |  |  |  |  |  |  | } | 
| 1519 |  |  |  |  |  |  |  | 
| 1520 |  |  |  |  |  |  |  | 
| 1521 |  |  |  |  |  |  | Remove personal identifiers from Apple's iTMS .m4a format files. | 
| 1522 |  |  |  |  |  |  |  | 
| 1523 |  |  |  |  |  |  | Note: to prevent inadvertent alteration of non-Apple .m4a files, the function | 
| 1524 |  |  |  |  |  |  | requires a m4a atom to be part of the file unless the "force" argument is used, eg. | 
| 1525 |  |  |  |  |  |  |  | 
| 1526 |  |  |  |  |  |  | $qt->CleanAppleM4aPersonalData( force => 1, zero_free_atoms => 1 ); | 
| 1527 |  |  |  |  |  |  |  | 
| 1528 |  |  |  |  |  |  | Here, the zero_free_atoms => 1 named argument forces all data in free atoms | 
| 1529 |  |  |  |  |  |  | to be nulled out as well. | 
| 1530 |  |  |  |  |  |  |  | 
| 1531 |  |  |  |  |  |  |  | 
| 1532 |  |  |  |  |  |  | =back | 
| 1533 |  |  |  |  |  |  |  | 
| 1534 |  |  |  |  |  |  | =head2 Class Internal Methods and Functions | 
| 1535 |  |  |  |  |  |  |  | 
| 1536 |  |  |  |  |  |  | =over 4 | 
| 1537 |  |  |  |  |  |  |  | 
| 1538 |  |  |  |  |  |  | =item AtomList | 
| 1539 |  |  |  |  |  |  |  | 
| 1540 |  |  |  |  |  |  | =item AtomTree | 
| 1541 |  |  |  |  |  |  |  | 
| 1542 |  |  |  |  |  |  | =item ConvertDrmsToMp4a | 
| 1543 |  |  |  |  |  |  |  | 
| 1544 |  |  |  |  |  |  | =item DeleteAtom | 
| 1545 |  |  |  |  |  |  |  | 
| 1546 |  |  |  |  |  |  | =item DeleteAtomWithStcoFix | 
| 1547 |  |  |  |  |  |  |  | 
| 1548 |  |  |  |  |  |  | =item DumpTree | 
| 1549 |  |  |  |  |  |  |  | 
| 1550 |  |  |  |  |  |  | =item FindAtom | 
| 1551 |  |  |  |  |  |  |  | 
| 1552 |  |  |  |  |  |  | =item FindAtomData | 
| 1553 |  |  |  |  |  |  |  | 
| 1554 |  |  |  |  |  |  | =item FixStco | 
| 1555 |  |  |  |  |  |  |  | 
| 1556 |  |  |  |  |  |  | =item GetSampleTable | 
| 1557 |  |  |  |  |  |  |  | 
| 1558 |  |  |  |  |  |  | =item MakeIlstAtom | 
| 1559 |  |  |  |  |  |  |  | 
| 1560 |  |  |  |  |  |  | =item MetaInfo | 
| 1561 |  |  |  |  |  |  |  | 
| 1562 |  |  |  |  |  |  | =item ParseDrms | 
| 1563 |  |  |  |  |  |  |  | 
| 1564 |  |  |  |  |  |  | =item ParseMP4Container | 
| 1565 |  |  |  |  |  |  |  | 
| 1566 |  |  |  |  |  |  | =item ParseMeta | 
| 1567 |  |  |  |  |  |  |  | 
| 1568 |  |  |  |  |  |  | =item ParseStsd | 
| 1569 |  |  |  |  |  |  |  | 
| 1570 |  |  |  |  |  |  | =item ParseMp4a | 
| 1571 |  |  |  |  |  |  |  | 
| 1572 |  |  |  |  |  |  | =item genre_num_to_genre_text | 
| 1573 |  |  |  |  |  |  |  | 
| 1574 |  |  |  |  |  |  | =item genre_text_to_genre_num | 
| 1575 |  |  |  |  |  |  |  | 
| 1576 |  |  |  |  |  |  | =item isMetaDataType | 
| 1577 |  |  |  |  |  |  |  | 
| 1578 |  |  |  |  |  |  | =item Get3GPInfo | 
| 1579 |  |  |  |  |  |  |  | 
| 1580 |  |  |  |  |  |  | =item GetFtype | 
| 1581 |  |  |  |  |  |  |  | 
| 1582 |  |  |  |  |  |  | =item Set3GPInfo | 
| 1583 |  |  |  |  |  |  |  | 
| 1584 |  |  |  |  |  |  | =item asset_language_pack_iso_639_2T | 
| 1585 |  |  |  |  |  |  |  | 
| 1586 |  |  |  |  |  |  | =back | 
| 1587 |  |  |  |  |  |  |  | 
| 1588 |  |  |  |  |  |  | =head1 BUGS | 
| 1589 |  |  |  |  |  |  |  | 
| 1590 |  |  |  |  |  |  | =over 4 | 
| 1591 |  |  |  |  |  |  |  | 
| 1592 |  |  |  |  |  |  | The Audio::M4P::* code is not re-entrant on a per-file basis, due to recursive | 
| 1593 |  |  |  |  |  |  | changes to containers not being thread-safe. Threaded code using these modules | 
| 1594 |  |  |  |  |  |  | may need to lock down all method calls with a semaphore or other serialization | 
| 1595 |  |  |  |  |  |  | method, unless only one thread is used to modify any given audio file. | 
| 1596 |  |  |  |  |  |  |  | 
| 1597 |  |  |  |  |  |  | =back | 
| 1598 |  |  |  |  |  |  |  | 
| 1599 |  |  |  |  |  |  | =head1 SEE ALSO WITH THIS MODULE | 
| 1600 |  |  |  |  |  |  |  | 
| 1601 |  |  |  |  |  |  | =over 4 | 
| 1602 |  |  |  |  |  |  |  | 
| 1603 |  |  |  |  |  |  | =item L, L | 
| 1604 |  |  |  |  |  |  |  | 
| 1605 |  |  |  |  |  |  | =back | 
| 1606 |  |  |  |  |  |  |  | 
| 1607 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 1608 |  |  |  |  |  |  |  | 
| 1609 |  |  |  |  |  |  | =over 4 | 
| 1610 |  |  |  |  |  |  |  | 
| 1611 |  |  |  |  |  |  | =item L, L | 
| 1612 |  |  |  |  |  |  |  | 
| 1613 |  |  |  |  |  |  | =item L, L, L, L, L, L, L, L | 
| 1614 |  |  |  |  |  |  |  | 
| 1615 |  |  |  |  |  |  | =back | 
| 1616 |  |  |  |  |  |  |  | 
| 1617 |  |  |  |  |  |  | =head1 AUTHOR | 
| 1618 |  |  |  |  |  |  |  | 
| 1619 |  |  |  |  |  |  | =over 4 | 
| 1620 |  |  |  |  |  |  |  | 
| 1621 |  |  |  |  |  |  | William Herrera B. | 
| 1622 |  |  |  |  |  |  |  | 
| 1623 |  |  |  |  |  |  | =back | 
| 1624 |  |  |  |  |  |  |  | 
| 1625 |  |  |  |  |  |  | =head1 SUPPORT | 
| 1626 |  |  |  |  |  |  |  | 
| 1627 |  |  |  |  |  |  | =over 4 | 
| 1628 |  |  |  |  |  |  |  | 
| 1629 |  |  |  |  |  |  | Questions, feature requests and bug reports should go to | 
| 1630 |  |  |  |  |  |  | . | 
| 1631 |  |  |  |  |  |  |  | 
| 1632 |  |  |  |  |  |  | =back | 
| 1633 |  |  |  |  |  |  |  | 
| 1634 |  |  |  |  |  |  | =head1 COPYRIGHT | 
| 1635 |  |  |  |  |  |  |  | 
| 1636 |  |  |  |  |  |  | =over 4 | 
| 1637 |  |  |  |  |  |  |  | 
| 1638 |  |  |  |  |  |  | Copyright (c) 2003-2008 William Herrera. All rights reserved. | 
| 1639 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify | 
| 1640 |  |  |  |  |  |  | it under the same terms as Perl itself. | 
| 1641 |  |  |  |  |  |  |  | 
| 1642 |  |  |  |  |  |  | =back | 
| 1643 |  |  |  |  |  |  |  | 
| 1644 |  |  |  |  |  |  | =cut | 
| 1645 |  |  |  |  |  |  |  | 
| 1646 |  |  |  |  |  |  | 1; |