Audio-FLAC-Header-2.4/0000755000076500007650000000000011445140560013575 5ustar danieldanielAudio-FLAC-Header-2.4/inc/0000755000076500007650000000000011445140560014346 5ustar danieldanielAudio-FLAC-Header-2.4/inc/Module/0000755000076500007650000000000011445140560015573 5ustar danieldanielAudio-FLAC-Header-2.4/inc/Module/Install.pm0000644000076500007650000002116211243275734017551 0ustar danieldaniel#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } BEGIN { require 5.004; } use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.77'; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" } Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); use Cwd (); use File::Find (); use File::Path (); use FindBin; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unless ( uc($1) eq $1 ) { unshift @_, ( $self, $1 ); goto &{$self->can('call')}; } }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; open FH, "< $_[0]" or die "open($_[0]): $!"; my $str = do { local $/; }; close FH or die "close($_[0]): $!"; return $str; } sub _write { local *FH; open FH, "> $_[0]" or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" } close FH or die "close($_[0]): $!"; } # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s ) ? $_[0] : undef; } 1; # Copyright 2008 Adam Kennedy. Audio-FLAC-Header-2.4/inc/Module/Install/0000755000076500007650000000000011445140560017201 5ustar danieldanielAudio-FLAC-Header-2.4/inc/Module/Install/AutoInstall.pm0000644000076500007650000000227211243275735022012 0ustar danieldaniel#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; Audio-FLAC-Header-2.4/inc/Module/Install/Include.pm0000644000076500007650000000101411243275735021127 0ustar danieldaniel#line 1 package Module::Install::Include; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; Audio-FLAC-Header-2.4/inc/Module/Install/Makefile.pm0000644000076500007650000001454611243275735021277 0ustar danieldaniel#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ( $self->{makemaker_args} ||= {} ); %$args = ( %$args, @_ ); return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Make sure we have a new enough require ExtUtils::MakeMaker; # MakeMaker can complain about module versions that include # an underscore, even though its own version may contain one! # Hence the funny regexp to get rid of it. See RT #35800 # for details. $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); # Generate the my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 379 Audio-FLAC-Header-2.4/inc/Module/Install/Metadata.pm0000644000076500007650000002700211243275735021271 0ustar danieldaniel#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}{resources} }; } return $self->{values}{resources}{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } sub requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{requires} }, [ $module, $version ]; } $self->{values}{requires}; } sub build_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{build_requires} }, [ $module, $version ]; } $self->{values}{build_requires}; } sub configure_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{configure_requires} }, [ $module, $version ]; } $self->{values}{configure_requires}; } sub recommends { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{recommends} }, [ $module, $version ]; } $self->{values}{recommends}; } sub bundles { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{bundles} }, [ $module, $version ]; } $self->{values}{bundles}; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}{resources} ||= []; push @{ $self->{values}{resources} }, [ $name, $value ]; } $self->{values}{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{values}{sign} if defined wantarray and ! @_; $self->{values}{sign} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; return $self->{values}{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). $version =~ s/^(\d+)\.(\d+)\.(\d+)$/sprintf("%d.%03d%03d",$1,$2,$3)/e; $version =~ s/_.+$//; $version = $version + 0; # Numify unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}{perl_version} = $version; return 1; } sub license { my $self = shift; return $self->{values}{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $self->{values}{license} = $license; # Automatically fill in license URLs if ( $license eq 'perl' ) { $self->resources( license => 'http://dev.perl.org/licenses/' ); } return 1; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless $self->author; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}{features} ? @{ $self->{values}{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub perl_version_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub license_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n"; } $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g; unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than on rt.cpan.org link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die("Cannot find script '$_'"); } } } 1; Audio-FLAC-Header-2.4/inc/Module/Install/WriteAll.pm0000644000076500007650000000132111243275735021270 0ustar danieldaniel#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.77'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } } 1; Audio-FLAC-Header-2.4/inc/Module/Install/Win32.pm0000644000076500007650000000340211243275735020451 0ustar danieldaniel#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.77'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Audio-FLAC-Header-2.4/inc/Module/Install/Fetch.pm0000644000076500007650000000463011243275735020604 0ustar danieldaniel#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Audio-FLAC-Header-2.4/inc/Module/Install/Compiler.pm0000644000076500007650000000211611243275735021322 0ustar danieldaniel#line 1 package Module::Install::Compiler; use strict; use Module::Install::Base; use File::Basename (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub ppport { my $self = shift; if ( $self->is_admin ) { return $self->admin->ppport(@_); } else { # Fallback to just a check my $file = shift || 'ppport.h'; unless ( -f $file ) { die "Packaging error, $file is missing"; } } } sub cc_files { require Config; my $self = shift; $self->makemaker_args( OBJECT => join ' ', map { substr($_, 0, -2) . $Config::Config{_o} } @_ ); } sub cc_inc_paths { my $self = shift; $self->makemaker_args( INC => join ' ', map { "-I$_" } @_ ); } sub cc_lib_paths { my $self = shift; $self->makemaker_args( LIBS => join ' ', map { "-L$_" } @_ ); } sub cc_lib_links { my $self = shift; $self->makemaker_args( LIBS => join ' ', $self->makemaker_args->{LIBS}, map { "-l$_" } @_ ); } sub cc_optimize_flags { my $self = shift; $self->makemaker_args( OPTIMIZE => join ' ', @_ ); } 1; __END__ #line 123 Audio-FLAC-Header-2.4/inc/Module/Install/Base.pm0000644000076500007650000000205011243275735020417 0ustar danieldaniel#line 1 package Module::Install::Base; $VERSION = '0.77'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 101 sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 146 Audio-FLAC-Header-2.4/inc/Module/Install/Can.pm0000644000076500007650000000342211243275735020252 0ustar danieldaniel#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 158 Audio-FLAC-Header-2.4/inc/Module/Install/External.pm0000644000076500007650000000277211243275735021342 0ustar danieldaniel#line 1 package Module::Install::External; # Provides dependency declarations for external non-Perl things use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub requires_external_cc { my $self = shift; # We need a C compiler, use the can_cc method for this unless ( $self->can_cc ) { print "Unresolvable missing external dependency.\n"; print "This package requires a C compiler.\n"; print STDERR "NA: Unable to build distribution on this platform.\n"; exit(0); } # Unlike some of the other modules, while we need to specify a # C compiler as a dep, it needs to be a build-time dependency. 1; } sub requires_external_bin { my ($self, $bin, $version) = @_; if ( $version ) { die "requires_external_bin does not support versions yet"; } # Load the package containing can_run early, # to avoid breaking the message below. $self->load('can_run'); # Locate the bin print "Locating required external dependency bin:$bin..."; my $found_bin = $self->can_run( $bin ); if ( $found_bin ) { print " found at $found_bin.\n"; } else { print " missing.\n"; print "Unresolvable missing external dependency.\n"; print "Please install '$bin' seperately and try again.\n"; print STDERR "NA: Unable to build distribution on this platform.\n"; exit(0); } # Once we have some way to specify external deps, do it here. # In the mean time, continue as normal. 1; } 1; __END__ #line 138 Audio-FLAC-Header-2.4/inc/Module/AutoInstall.pm0000644000076500007650000005077211243275735020414 0ustar danieldaniel#line 1 package Module::AutoInstall; use strict; use Cwd (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.03'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly ); my ( $PostambleActions, $PostambleUsed ); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. if ( defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) ) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } $UnderCPAN = _check_lock(); # check for $UnderCPAN if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) { require Config; print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { print <<'END_MESSAGE'; *** Since we're running under CPANPLUS, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } _load_cpan(); # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^force$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $args{force} ? CPAN::Shell->force( install => $pkg ) : CPAN::Shell->install($pkg); $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if defined( _version_check( _load($class), $ver ) ); # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # class/instance doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION; require CPAN; if ( $CPAN::HandleConfig::VERSION ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison sub _version_check { my ( $cur, $min ) = @_; return unless defined $cur; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return ( ( version->new($cur) >= version->new($min) ) ? $cur : undef ); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 ) ? $cur : undef ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return ( $cur >= $min ? $cur : undef ); } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; return << "."; config :: installdeps \t\$(NOECHO) \$(NOOP) checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions . } 1; __END__ #line 1003 Audio-FLAC-Header-2.4/t/0000755000076500007650000000000011445140560014040 5ustar danieldanielAudio-FLAC-Header-2.4/t/md5.t0000644000076500007650000000141011171776310014712 0ustar danieldaniel#!/usr/bin/perl -w use strict; use Test::More tests => 3; use File::Spec::Functions qw(:ALL); BEGIN { use_ok('Audio::FLAC::Header') }; ######################### { # Always test pure perl my @constructors = ('_new_PP'); # Only test XS if built SKIP: { eval { Audio::FLAC::Header->_new_XS(catdir('data', 'md5.flac')) }; skip "Not built with XS", 1 if $@; push @constructors, '_new_XS'; } # Be sure to test both code paths. for my $constructor (@constructors) { my $flac = Audio::FLAC::Header->$constructor(catdir('data', 'md5.flac')); my $info = $flac->info(); ok($flac->info('MD5CHECKSUM') eq '00428198e1ae27ad16754f75ff068752', "md5"); } } __END__ Audio-FLAC-Header-2.4/t/basic.t0000644000076500007650000000363311171777163015326 0ustar danieldaniel#!/usr/bin/perl -w use strict; use Test::More tests => 43; use File::Spec::Functions qw(:ALL); BEGIN { use_ok('Audio::FLAC::Header') }; ######################### { # Always test pure perl my @constructors = ('_new_PP'); # Only test XS if built SKIP: { eval { Audio::FLAC::Header->_new_XS(catdir('data', 'test.flac')) }; skip "Not built with XS", 21 if $@; push @constructors, '_new_XS'; } # Be sure to test both code paths. for my $constructor (@constructors) { my $flac = Audio::FLAC::Header->$constructor(catdir('data', 'test.flac')); ok($flac, "constructor: $constructor"); my $info = $flac->info(); ok($info, "info block"); ok($flac->info('SAMPLERATE') == 44100, "sample rate"); ok($flac->info('MD5CHECKSUM') eq '592fb7897a3589c6acf957fd3f8dc854', "md5"); ok($flac->info('TOTALSAMPLES') == 153200460, "total samples"); ok($flac->info('BITSPERSAMPLE') == 16, "bits per sample $constructor"); ok($flac->info('NUMCHANNELS') == 2, "channels $constructor"); ok($flac->info('MINIMUMBLOCKSIZE') == 4608, "minimum block size $constructor"); ok($flac->info('MAXIMUMBLOCKSIZE') == 4608, "maximum block size $constructor"); ok($flac->info('MINIMUMFRAMESIZE') == 14, "minimum frame size $constructor"); ok($flac->info('MAXIMUMFRAMESIZE') == 18002, "maximum frame size $constructor"); my $tags = $flac->tags(); ok($tags, "tags read"); is($flac->tags('AUTHOR'), 'Praga Khan', "AUTHOR ok"); # XXX - should have accessors ok($flac->{'trackLengthFrames'} =~ /70.00\d+/); ok($flac->{'trackLengthMinutes'} == 57); ok($flac->{'bitRate'} =~ /1.236\d+/); ok($flac->{'trackTotalLengthSeconds'} =~ /3473.93\d+/); my $cue = $flac->cuesheet(); ok $cue; ok(scalar @{$cue} == 37); ok($cue->[35] =~ /REM FLAC__lead-in 88200/); ok($cue->[36] =~ /REM FLAC__lead-out 170 153200460/); } } __END__ Audio-FLAC-Header-2.4/t/pod-coverage.t0000644000076500007650000000044311150671243016601 0ustar danieldaniel#!/usr/bin/perl use Test::More; eval "use Test::Pod::Coverage"; plan skip_all => "Test::Pod::Coverage required for testing pod coverage" if $@; plan tests => 1; pod_coverage_ok( "Audio::FLAC::Header", { also_private => ['dl_load_flags'] }, "Audio::FLAC::Header is covered" ); Audio-FLAC-Header-2.4/t/pod.t0000644000076500007650000000021411150671243015004 0ustar danieldaniel#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Audio-FLAC-Header-2.4/t/picture.t0000644000076500007650000000210311171776310015700 0ustar danieldaniel#!/usr/bin/perl -w use strict; use Test::More tests => 7; use File::Spec::Functions qw(:ALL); BEGIN { use_ok('Audio::FLAC::Header') }; ######################### { # Always test pure perl my @constructors = ('_new_PP'); # Only test XS if built SKIP: { eval { Audio::FLAC::Header->_new_XS(catdir('data', 'picture.flac')) }; skip "Not built with XS", 3 if $@; push @constructors, '_new_XS'; } # Be sure to test both code paths. for my $constructor (@constructors) { my $flac = Audio::FLAC::Header->$constructor(catdir('data', 'picture.flac')); my $vendor = $flac->vendor_string; my $has_picture = 1; if ($vendor =~ /libFLAC\s+(\d+\.\d+\.\d+)/) { if ($1 lt '1.1.3') { $has_picture = 0; } } SKIP: { skip "XS - No PICTURE support", 3 unless $has_picture; ok($flac, "constructor: $constructor"); my $picture = $flac->picture(); ok($picture, "found picture"); ok($picture->{'mimeType'} eq 'image/jpeg', "found jpeg"); } } } __END__ Audio-FLAC-Header-2.4/t/application-id.t0000644000076500007650000000156411171776575017151 0ustar danieldaniel#!/usr/bin/perl -w use strict; use Test::More tests => 11; use File::Spec::Functions qw(:ALL); BEGIN { use_ok('Audio::FLAC::Header') }; ######################### { # Always test pure perl my @constructors = ('_new_PP'); # Only test XS if built SKIP: { eval { Audio::FLAC::Header->_new_XS(catdir('data', 'appId.flac')) }; skip "Not built with XS", 5 if $@; push @constructors, '_new_XS'; } # Be sure to test both code paths. for my $constructor (@constructors) { my $flac = Audio::FLAC::Header->$constructor(catdir('data', 'appId.flac')); ok($flac, "constructor: $constructor"); my $info = $flac->info(); ok($info, "info exists"); my $cue = $flac->cuesheet(); ok($cue, "cue sheet exists"); my $app = $flac->application(1835361648); ok($app, "application block exists"); ok($app =~ /musicbrainz/, "found musicbrainz block"); } } __END__ Audio-FLAC-Header-2.4/t/write.t0000644000076500007650000000213311151157063015356 0ustar danieldaniel#!/usr/bin/perl -w use strict; use Test::More tests => 7; use File::Spec::Functions qw(:ALL); use File::Copy; BEGIN { use_ok('Audio::FLAC::Header') }; ######################### { # Always test pure perl my @modes = ('PP'); # Only test XS if built SKIP: { eval { Audio::FLAC::Header->_new_XS(catdir('data', 'empty.flac')) }; skip "Not built with XS", 3 if $@; push @modes, 'XS'; } # Be sure to test both code paths. for my $mode (@modes) { my $constructor = "_new_$mode"; my $write_method = "_write_$mode"; my $empty = catdir('data', 'empty.flac'); my $write = catdir('data', "write_$mode.flac"); copy($empty, $write); my $flac = Audio::FLAC::Header->$constructor($write); ok($flac, "constructor: $constructor"); my $tags = $flac->tags; $tags->{'ALBUM'} = 'FOO'; ok($flac->$write_method, "Wrote out tags"); undef $flac; my $read = Audio::FLAC::Header->$constructor($write); ok($read->tags('ALBUM') eq 'FOO', "Got written out tags"); unlink($write); } } __END__ Audio-FLAC-Header-2.4/t/id3tagged.t0000644000076500007650000000157311171776310016072 0ustar danieldaniel#!/usr/bin/perl -w use strict; use Test::More tests => 9; use File::Spec::Functions qw(:ALL); BEGIN { use_ok('Audio::FLAC::Header') }; ######################### { # Always test pure perl my @constructors = ('_new_PP'); # Only test XS if built SKIP: { eval { Audio::FLAC::Header->_new_XS(catdir('data', 'id3tagged.flac')) }; skip "Not built with XS", 4 if $@; push @constructors, '_new_XS'; } # Be sure to test both code paths. for my $constructor (@constructors) { my $flac = Audio::FLAC::Header->$constructor(catdir('data', 'id3tagged.flac')); ok($flac, "constructor: $constructor"); my $info = $flac->info(); ok($info, "info block"); my $tags = $flac->tags(); ok($tags, "tags read"); ok($tags->{'title'} =~ /Allegro Maestoso/, "found title"); } } __END__ Audio-FLAC-Header-2.4/Changes0000644000076500007650000000722311445140530015071 0ustar danieldanielRevision history for Perl extension Audio::FLAC. 2.4 Sat Sep 18 06:40:38 PDT 2010 - Fix _write_PP method. Now writes out vendor string, sorts padding. Which fixes bugs: https://rt.cpan.org/Ticket/Display.html?id=42305 and https://rt.cpan.org/Ticket/Display.html?id=42306 - Memory leak fixes in XS. - Patch from Nick for https://rt.cpan.org/Ticket/Display.html?id=44930 Allows PP only version. - Patch from Nick for https://rt.cpan.org/Ticket/Display.html?id=44943 _parseStreamInfo - Fix incorrect decoding of metadata - Better (hopefully) handling of VENDOR string. * Add set_vendor_string method. * Write out vendor string in XS. * Don't hardcode vendor string on read in XS. 2.3 Sat Nov 8 15:36:38 PST 2008 - Patch from Nick Hall to fix allpictures XS & Debian crash. 2.2 Sat May 17 00:42:06 PDT 2008 - Patches from Nick Hall to allow allpictures XS partity & multiple ID3 tag fixes - RT #36000 - Don't add vendor string, or change case of tags. - RT #36048 - Segfault if FLAC file doesn't contain VENDOR tag. 2.1 Sat May 17 00:42:06 PDT 2008 - Try and abort cpansmoke before it sends me email. 2.0 Sat Feb 23 13:32:54 PST 2008 - RT #32691: Picture $type incorrectly defaults to 3 for valid input 0 - "Other" - RT #32631: t/pod-coverage.t fails with Pod::Coverage 0.19 - RT #32693: Will not retrieve multiple pictures of the same picture type - RT #32630: Test failure on several architectures (64-bit problems) XS - Fixed compile warnings. 1.9 Sun Dec 2 09:44:22 PST 2007 - Fix Test::Pod::Coverage usage. - XS: RT #30532 - Bug when writing tags when only two tags are left 1.8 Thu Jul 26 14:02:51 PDT 2007 - XS: Fix reading MD5 when leading with 00. Add tests. - Update Documentation to reflect return value reality. 1.7 Fri Jan 5 15:50:46 PST 2007 - XS: RT #15415 - use the block length when storing the application block. - Add POD & POD Coverage tests. - Fix META.yml - Use Module::Install 1.6 Thu Jan 4 19:09:35 PST 2007 - Remove extraneous debugging 1.5 Thu Jan 4 14:44:37 PST 2007 - PP: Large refactor to improve performance. Only parse blocks we encounter. - PP: Don't parse the SEEKTABLE block as it's really slow and not that useful. - PP & XS: Parse the PICTURE metadata block from FLAC 1.1.3 - XS: Implement writing vorbis comments. - Updated tests 1.4 Sat Feb 19 16:24:05 PST 2005 - Fix win32 build problems. stat() == _stat() - Other minor fixes to stop warnings. 1.3 Wed Feb 16 13:59:40 PST 2005 - Skip ID3 tags in the XS code. - Add additional tests for ID3 tag skipping. 1.2 Tue Nov 16 14:29:25 PST 2004 - Make PADDING blocks be filled will nulls, not spaces. - Always write out the fLaC header. - Add in a hack to make write() work again. 1.1 Fri Oct 1 21:50:33 PDT 2004 - Fixed application ID parsing in XS code. - Added more tests for application ID. 1.0 Tue Sep 28 23:54:53 PDT 2004 - Implemented an XS binding to the metadata interface in libFLAC, resulting in a much faster parser. - Try to use the XS code first, but fall back to Pure Perl. 0.8 Sat Jul 10 15:03:52 PDT 2004 - Add application block parsing from Michael Turner. 0.7 Thu Jan 29 08:44:20 PST 2004 - Added more debug info when we can't get data. - Fixed some bugs from Jason Holtzapple. 0.6 Mon Jan 26 20:10:26 PST 2004 - Added cuesheet parsing from Michael. - Continue if there is no vorbis comment, which is valid. 0.5 Mon Dec 15 08:28:12 2003 - Add ID3 skipping code, return hashrefs, writeTag code. 0.01 Tue Nov 25 16:07:46 2003 - original version; created by h2xs 1.23 with options -A -X -b 5.5.3 -c -n Audio::FLAC --skip-warnings Audio-FLAC-Header-2.4/MANIFEST0000644000076500007650000000120311150671243014722 0ustar danieldanielChanges Makefile.PL MANIFEST README data/test.flac data/id3tagged.flac data/appId.flac data/empty.flac data/md5.flac data/picture.flac t/basic.t t/pod.t t/pod-coverage.t t/application-id.t t/id3tagged.t t/md5.t t/picture.t t/write.t Header.pm Header.xs META.yml TODO inc/Module/Install.pm inc/Module/Install/Metadata.pm inc/Module/Install/Base.pm inc/Module/Install/Compiler.pm inc/Module/Install/Makefile.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Include.pm inc/Module/Install/External.pm inc/Module/Install/WriteAll.pm inc/Module/Install/Win32.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/AutoInstall.pm Audio-FLAC-Header-2.4/TODO0000644000076500007650000000004711150671243014266 0ustar danieldaniel* Write out cuesheet & picture blocks. Audio-FLAC-Header-2.4/Header.pm0000644000076500007650000007007511243275731015341 0ustar danieldanielpackage Audio::FLAC::Header; # $Id$ use strict; use File::Basename; our $VERSION = '2.4'; our $HAVE_XS = 0; # First four bytes of stream are always fLaC my $FLACHEADERFLAG = 'fLaC'; my $ID3HEADERFLAG = 'ID3'; # Masks for METADATA_BLOCK_HEADER my $LASTBLOCKFLAG = 0x80000000; my $BLOCKTYPEFLAG = 0x7F000000; my $BLOCKLENFLAG = 0x00FFFFFF; # Enumerated Block Types my $BT_STREAMINFO = 0; my $BT_PADDING = 1; my $BT_APPLICATION = 2; my $BT_SEEKTABLE = 3; my $BT_VORBIS_COMMENT = 4; my $BT_CUESHEET = 5; my $BT_PICTURE = 6; my $VENDOR_STRING = __PACKAGE__ . " v$VERSION"; my %BLOCK_TYPES = ( $BT_STREAMINFO => '_parseStreamInfo', $BT_APPLICATION => '_parseAppBlock', # The seektable isn't actually useful yet, and is a big performance hit. # $BT_SEEKTABLE => '_parseSeekTable', $BT_VORBIS_COMMENT => '_parseVorbisComments', $BT_CUESHEET => '_parseCueSheet', $BT_PICTURE => '_parsePicture', ); XS_BOOT: { # If I inherit DynaLoader then I inherit AutoLoader require DynaLoader; # DynaLoader calls dl_load_flags as a static method. *dl_load_flags = DynaLoader->can('dl_load_flags'); $HAVE_XS = eval { do {__PACKAGE__->can('bootstrap') || \&DynaLoader::bootstrap}->(__PACKAGE__, $VERSION); return 1; }; # Try to use the faster code first. if ($HAVE_XS) { *new = \&_new_XS; *write = \&_write_XS; } else { *new = \&_new_PP; *write = \&_write_PP; } } sub _new_PP { my ($class, $file) = @_; # open up the file open(my $fh, $file) or die "[$file] does not exist or cannot be read: $!"; # make sure dos-type systems can handle it... binmode($fh); my $self = { 'fileSize' => -s $file, 'filename' => $file, }; bless $self, $class; # check the header to make sure this is actually a FLAC file my $byteCount = $self->_checkHeader($fh) || 0; if ($byteCount <= 0) { close($fh); die "[$file] does not appear to be a FLAC file!"; } $self->{'startMetadataBlocks'} = $byteCount; # Grab the metadata blocks from the FLAC file if (!$self->_getMetadataBlocks($fh)) { close($fh); die "[$file] Unable to read metadata from FLAC!"; }; # Always set to empty hash in the case of no comments. $self->{'tags'} = {}; for my $block (@{$self->{'metadataBlocks'}}) { my $method = $BLOCK_TYPES{ $block->{'blockType'} } || next; $self->$method($block); } close($fh); return $self; } sub info { my $self = shift; my $key = shift; # if the user did not supply a key, return a hashref return $self->{'info'} unless $key; # otherwise, return the value for the given key return $self->{'info'}->{$key}; } sub tags { my $self = shift; my $key = shift; # if the user did not supply a key, return a hashref return $self->{'tags'} unless $key; # otherwise, return the value for the given key return $self->{'tags'}->{$key}; } sub cuesheet { my $self = shift; # if the cuesheet block exists, return it as an arrayref return $self->{'cuesheet'} if exists($self->{'cuesheet'}); # otherwise, return an empty arrayref return []; } sub seektable { my $self = shift; # if the seekpoint table block exists, return it as an arrayref return $self->{'seektable'} if exists($self->{'seektable'}); # otherwise, return an empty arrayref return []; } sub application { my $self = shift; my $appID = shift || "default"; # if the application block exists, return it's content return $self->{'application'}->{$appID} if exists($self->{'application'}->{$appID}); # otherwise, return nothing return undef; } sub picture { my $self = shift; my $type = shift; $type = 3 unless defined ($type); # defaults to front cover if ($type eq 'all') { return $self->{'allpictures'} if exists($self->{'allpictures'}); } # Also look for other types of images # http://flac.sourceforge.net/format.html#metadata_block_picture my @types = ($type, 4, 0, 5..20); # if the picture block exists, return it's content for (@types) { return $self->{'picture'}->{$_} if exists $self->{'picture'}->{$_}; } # otherwise, return nothing return undef; } sub vendor_string { my $self = shift; return $self->{'tags'}->{'VENDOR'} || ''; } sub set_vendor_string { my $self = shift; my $value = shift || $VENDOR_STRING; return $self->{'tags'}->{'VENDOR'} = $value; } sub set_separator { my $self = shift; $self->{'separator'} = shift; } sub _write_PP { my $self = shift; my @tagString = (); my $numTags = 0; my $numBlocks = 0; my ($idxVorbis,$idxPadding); my $totalAvail = 0; my $metadataBlocks = $FLACHEADERFLAG; my $tmpnum; # Make a list of the tags and lengths for packing into the vorbis metadata block foreach (keys %{$self->{'tags'}}) { unless (/^VENDOR$/) { push @tagString, $_ . "=" . $self->{'tags'}{$_}; $numTags++; } } # Create the contents of the vorbis comment metablock with the number of tags my $vorbisComment = ""; # Vendor comment must come first. _addStringToComment(\$vorbisComment, ($self->{'tags'}->{'VENDOR'} || $VENDOR_STRING)); $vorbisComment .= _packInt32($numTags); # Finally, each tag string (with length) foreach (@tagString) { _addStringToComment(\$vorbisComment, $_); } # Is there enough space for this new header? # Determine the length of the old comment block and the length of the padding available $idxVorbis = $self->_findMetadataIndex($BT_VORBIS_COMMENT); $idxPadding = $self->_findMetadataIndex($BT_PADDING); if ($idxVorbis >= 0) { # Add the length of the block $totalAvail += $self->{'metadataBlocks'}[$idxVorbis]->{'blockSize'}; } else { # Subtract 4 (min size of block when added) $totalAvail -= 4; } if ($idxPadding >= 0) { # Add the length of the block $totalAvail += $self->{'metadataBlocks'}[$idxPadding]->{'blockSize'}; } else { # Subtract 4 (min size of block when added) $totalAvail -= 4; } # Check for not enough space to write tag without # re-writing entire file (not within scope) if ($totalAvail - length($vorbisComment) < 0) { warn "Unable to write Vorbis tags - not enough header space!"; return 0; } # Modify the metadata blocks to reflect new header sizes # Is there a Vorbis metadata block? if ($idxVorbis < 0) { # no vorbis block, so add one _addNewMetadataBlock($self, $BT_VORBIS_COMMENT, $vorbisComment); } else { # update the vorbis block _updateMetadataBlock($self, $idxVorbis, $vorbisComment); } # Is there a Padding block? # Change the padding to reflect the new vorbis comment size if ($idxPadding < 0) { # no padding block _addNewMetadataBlock($self, $BT_PADDING , "\0" x ($totalAvail - length($vorbisComment))); } else { # update the padding block _updateMetadataBlock($self, $idxPadding, "\0" x ($totalAvail - length($vorbisComment))); } $numBlocks = @{$self->{'metadataBlocks'}}; # Sort so that all the padding is at the end. # Our version of FLAC__metadata_chain_sort_padding() for (my $i = 0; $i < $numBlocks; $i++) { my $block = $self->{'metadataBlocks'}->[$i]; if ($block->{'blockType'} == $BT_PADDING) { if (my $next = splice(@{$self->{'metadataBlocks'}}, $i+1, 1)) { splice(@{$self->{'metadataBlocks'}}, $i, 1, $next); push @{$self->{'metadataBlocks'}}, $block; } } } # Now set the last block. $self->{'metadataBlocks'}->[-1]->{'lastBlockFlag'} = 1; # Create the metadata block structure for the FLAC file foreach (@{$self->{'metadataBlocks'}}) { $tmpnum = $_->{'lastBlockFlag'} << 31; $tmpnum |= $_->{'blockType'} << 24; $tmpnum |= $_->{'blockSize'}; $metadataBlocks .= pack "N", $tmpnum; $metadataBlocks .= $_->{'contents'}; } # open FLAC file and write new metadata blocks open FLACFILE, "+<$self->{'filename'}" or return 0; binmode FLACFILE; # overwrite the existing metadata blocks my $ret = syswrite(FLACFILE, $metadataBlocks, length($metadataBlocks), 0); close FLACFILE; return $ret; } # private methods to this class sub _checkHeader { my ($self, $fh) = @_; # check that the first four bytes are 'fLaC' read($fh, my $buffer, 4) or return -1; if (substr($buffer,0,3) eq $ID3HEADERFLAG) { $self->{'ID3V2Tag'} = 1; my $id3size = ''; # How big is the ID3 header? # Skip the next two bytes - major & minor version number. read($fh, $buffer, 2) or return -1; # The size of the ID3 tag is a 'synchsafe' 4-byte uint # Read the next 4 bytes one at a time, unpack each one B7, # and concatenate. When complete, do a bin2dec to determine size for (my $c = 0; $c < 4; $c++) { read($fh, $buffer, 1) or return -1; $id3size .= substr(unpack ("B8", $buffer), 1); } seek $fh, _bin2dec($id3size) + 10, 0; read($fh, $buffer, 4) or return -1; } if ($buffer ne $FLACHEADERFLAG) { warn "Unable to identify $self->{'filename'} as a FLAC bitstream!\n"; return -2; } # at this point, we assume the bitstream is valid return tell($fh); } sub _getMetadataBlocks { my ($self, $fh) = @_; my $metadataBlockList = []; my $numBlocks = 0; my $lastBlockFlag = 0; my $buffer; # Loop through all of the metadata blocks while ($lastBlockFlag == 0) { # Read the next metadata_block_header read($fh, $buffer, 4) or return 0; my $metadataBlockHeader = unpack('N', $buffer); # Break out the contents of the metadata_block_header my $metadataBlockType = ($BLOCKTYPEFLAG & $metadataBlockHeader)>>24; my $metadataBlockLength = ($BLOCKLENFLAG & $metadataBlockHeader); $lastBlockFlag = ($LASTBLOCKFLAG & $metadataBlockHeader)>>31; # If the block size is zero go to the next block next unless $metadataBlockLength; # Read the contents of the metadata_block read($fh, my $metadataBlockData, $metadataBlockLength) or return 0; # Store the parts in the list $metadataBlockList->[$numBlocks++] = { 'lastBlockFlag' => $lastBlockFlag, 'blockType' => $metadataBlockType, 'blockSize' => $metadataBlockLength, 'contents' => $metadataBlockData }; } # Store the metadata blocks in the hash $self->{'metadataBlocks'} = $metadataBlockList; $self->{'startAudioData'} = tell $fh; return 1; } sub _parseStreamInfo { my ($self, $block) = @_; my $info = {}; # Convert to binary string, since there's some unfriendly lengths ahead my $metaBinString = unpack('B144', $block->{'contents'}); my $x32 = 0 x 32; $info->{'MINIMUMBLOCKSIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 0, 16), -32))); $info->{'MAXIMUMBLOCKSIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 16, 16), -32))); $info->{'MINIMUMFRAMESIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 32, 24), -32))); $info->{'MAXIMUMFRAMESIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 56, 24), -32))); $info->{'SAMPLERATE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 80, 20), -32))); $info->{'NUMCHANNELS'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 100, 3), -32))) + 1; $info->{'BITSPERSAMPLE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 103, 5), -32))) + 1; # Calculate total samples in two parts my $highBits = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 108, 4), -32))); $info->{'TOTALSAMPLES'} = $highBits * 2 ** 32 + unpack('N', pack('B32', substr($x32 . substr($metaBinString, 112, 32), -32))); # Return the MD5 as a 32-character hexadecimal string #$info->{'MD5CHECKSUM'} = unpack('H32',substr($self->{'metadataBlocks'}[$idx]->{'contents'},18,16)); $info->{'MD5CHECKSUM'} = unpack('H32',substr($block->{'contents'}, 18, 16)); # Store in the data hash $self->{'info'} = $info; # Calculate the track times my $totalSeconds = $info->{'TOTALSAMPLES'} / $info->{'SAMPLERATE'}; if ($totalSeconds == 0) { warn "totalSeconds is 0 - we couldn't find either TOTALSAMPLES or SAMPLERATE!\n" . "setting totalSeconds to 1 to avoid divide by zero error!\n"; $totalSeconds = 1; } $self->{'trackTotalLengthSeconds'} = $totalSeconds; $self->{'trackLengthMinutes'} = int(int($totalSeconds) / 60); $self->{'trackLengthSeconds'} = int($totalSeconds) % 60; $self->{'trackLengthFrames'} = ($totalSeconds - int($totalSeconds)) * 75; $self->{'bitRate'} = 8 * ($self->{'fileSize'} - $self->{'startAudioData'}) / $totalSeconds; return 1; } sub _parseVorbisComments { my ($self, $block) = @_; my $tags = {}; my $rawTags = []; # Parse out the tags from the metadata block my $tmpBlock = $block->{'contents'}; my $offset = 0; # First tag in block is the Vendor String my $tagLen = unpack('V', substr($tmpBlock, $offset, 4)); $tags->{'VENDOR'} = substr($tmpBlock, ($offset += 4), $tagLen); # Now, how many additional tags are there? my $numTags = unpack('V', substr($tmpBlock, ($offset += $tagLen), 4)); $offset += 4; for (my $tagi = 0; $tagi < $numTags; $tagi++) { # Read the tag string my $tagLen = unpack('V', substr($tmpBlock, $offset, 4)); my $tagStr = substr($tmpBlock, ($offset += 4), $tagLen); # Save the raw tag push(@$rawTags, $tagStr); # Match the key and value if ($tagStr =~ /^(.*?)=(.*?)[\r\n]*$/s) { my $tkey = $1; # Stick it in the tag hash - and handle multiple tags # of the same name. if (exists $tags->{$tkey} && ref($tags->{$tkey}) ne 'ARRAY') { my $oldValue = $tags->{$tkey}; $tags->{$tkey} = [ $oldValue, $2 ]; } elsif (ref($tags->{$tkey}) eq 'ARRAY') { push @{$tags->{$tkey}}, $2; } else { $tags->{$tkey} = $2; } } $offset += $tagLen; } $self->{'tags'} = $tags; $self->{'rawTags'} = $rawTags; return 1; } sub _parseCueSheet { my ($self, $block) = @_; my $cuesheet = []; # Parse out the tags from the metadata block my $tmpBlock = $block->{'contents'}; # First field in block is the Media Catalog Number my $catalog = substr($tmpBlock,0,128); $catalog =~ s/\x00+.*$//gs; # trim nulls off of the end push (@$cuesheet, "CATALOG $catalog\n") if length($catalog) > 0; $tmpBlock = substr($tmpBlock,128); # metaflac uses "dummy.wav" but we're going to use the actual filename # this will help external parsers that have to associate the resulting # cuesheet with this flac file. push (@$cuesheet, "FILE \"" . basename("$self->{'filename'}") ."\" FLAC\n"); # Next field is the number of lead-in samples for CD-DA my $highbits = unpack('N', substr($tmpBlock,0,4)); my $leadin = $highbits * 2 ** 32 + unpack('N', (substr($tmpBlock,4,4))); $tmpBlock = substr($tmpBlock,8); # Flag to determine if this represents a CD my $bits = unpack('B8', substr($tmpBlock, 0, 1)); my $isCD = substr($bits, 0, 1); # Some sanity checking related to the CD flag if ($isCD && length($catalog) != 13 && length($catalog) != 0) { warn "Invalid Catalog entry\n"; return -1; } if (!$isCD && $leadin > 0) { warn "Lead-in detected for non-CD cue sheet.\n"; return -1; } # The next few bits should be zero. my $reserved = _bin2dec(substr($bits, 1, 7)); $reserved += unpack('B*', substr($tmpBlock, 1, 258)); if ($reserved != 0) { warn "Either the cue sheet is corrupt, or it's a newer revision than I can parse\n"; #return -1; # ?? may be harmless to continue ... } $tmpBlock = substr($tmpBlock,259); # Number of tracks my $numTracks = _bin2dec(unpack('B8',substr($tmpBlock,0,1))); $tmpBlock = substr($tmpBlock,1); if ($numTracks < 1 || ($isCD && $numTracks > 100)) { warn "Invalid number of tracks $numTracks\n"; return -1; } # Parse individual tracks now my %seenTracknumber = (); my $leadout = 0; my $leadouttracknum = 0; for (my $i = 1; $i <= $numTracks; $i++) { $highbits = unpack('N', substr($tmpBlock,0,4)); my $trackOffset = $highbits * 2 ** 32 + unpack('N', (substr($tmpBlock,4,4))); if ($isCD && $trackOffset % 588) { warn "Invalid track offset $trackOffset\n"; return -1; } my $tracknum = _bin2dec(unpack('B8',substr($tmpBlock,8,1))) || do { warn "Invalid track numbered \"0\" detected\n"; return -1; }; if ($isCD && $tracknum > 99 && $tracknum != 170) { warn "Invalid track number for a CD $tracknum\n"; return -1; } if (defined $seenTracknumber{$tracknum}) { warn "Invalid duplicate track number $tracknum\n"; return -1; } $seenTracknumber{$tracknum} = 1; my $isrc = substr($tmpBlock,9,12); $isrc =~ s/\x00+.*$//; if ((length($isrc) != 0) && (length($isrc) != 12)) { warn "Invalid ISRC code $isrc\n"; return -1; } $bits = unpack('B8', substr($tmpBlock, 21, 1)); my $isAudio = !substr($bits, 0, 1); my $preemphasis = substr($bits, 1, 1); # The next few bits should be zero. $reserved = _bin2dec(substr($bits, 2, 6)); $reserved += unpack('B*', substr($tmpBlock, 22, 13)); if ($reserved != 0) { warn "Either the cue sheet is corrupt, " . "or it's a newer revision than I can parse\n"; #return -1; # ?? may be harmless to continue ... } my $numIndexes = _bin2dec(unpack('B8',substr($tmpBlock,35,1))); $tmpBlock = substr($tmpBlock,36); # If we're on the lead-out track, stop before pushing TRACK info if ($i == $numTracks) { $leadout = $trackOffset; if ($isCD && $tracknum != 170) { warn "Incorrect lead-out track number $tracknum for CD\n"; return -1; } $leadouttracknum = $tracknum; next; } # Add TRACK info to cuesheet my $trackline = sprintf(" TRACK %02d %s\n", $tracknum, $isAudio ? "AUDIO" : "DATA"); push (@$cuesheet, $trackline); push (@$cuesheet, " FLAGS PRE\n") if ($preemphasis); push (@$cuesheet, " ISRC " . $isrc . "\n") if ($isrc); if ($numIndexes < 1 || ($isCD && $numIndexes > 100)) { warn "Invalid number of Indexes $numIndexes for track $tracknum\n"; return -1; } # Itterate through the indexes for this track for (my $j = 0; $j < $numIndexes; $j++) { $highbits = unpack('N', substr($tmpBlock,0,4)); my $indexOffset = $highbits * 2 ** 32 + unpack('N', (substr($tmpBlock,4,4))); if ($isCD && $indexOffset % 588) { warn "Invalid index offset $indexOffset\n"; return -1; } my $indexnum = _bin2dec(unpack('B8',substr($tmpBlock,8,1))); #TODO: enforce sequential indexes $reserved = 0; $reserved += unpack('B*', substr($tmpBlock, 9, 3)); if ($reserved != 0) { warn "Either the cue sheet is corrupt, " . "or it's a newer revision than I can parse\n"; #return -1; # ?? may be harmless to continue ... } my $timeoffset = _samplesToTime(($trackOffset + $indexOffset), $self->{'info'}->{'SAMPLERATE'}); return -1 unless defined ($timeoffset); my $indexline = sprintf (" INDEX %02d %s\n", $indexnum, $timeoffset); push (@$cuesheet, $indexline); $tmpBlock = substr($tmpBlock,12); } } # Add final comments just like metaflac would push (@$cuesheet, "REM FLAC__lead-in " . $leadin . "\n"); push (@$cuesheet, "REM FLAC__lead-out " . $leadouttracknum . " " . $leadout . "\n"); $self->{'cuesheet'} = $cuesheet; return 1; } sub _parsePicture { my ($self, $block) = @_; # Parse out the tags from the metadata block my $tmpBlock = $block->{'contents'}; my $offset = 0; my $pictureType = unpack('N', substr($tmpBlock, $offset, 4)); my $mimeLength = unpack('N', substr($tmpBlock, ($offset += 4), 4)); my $mimeType = substr($tmpBlock, ($offset += 4), $mimeLength); my $descLength = unpack('N', substr($tmpBlock, ($offset += $mimeLength), 4)); my $description = substr($tmpBlock, ($offset += 4), $descLength); my $width = unpack('N', substr($tmpBlock, ($offset += $descLength), 4)); my $height = unpack('N', substr($tmpBlock, ($offset += 4), 4)); my $depth = unpack('N', substr($tmpBlock, ($offset += 4), 4)); my $colorIndex = unpack('N', substr($tmpBlock, ($offset += 4), 4)); my $imageLength = unpack('N', substr($tmpBlock, ($offset += 4), 4)); my $imageData = substr($tmpBlock, ($offset += 4), $imageLength); $self->{'picture'}->{$pictureType}->{'mimeType'} = $mimeType; $self->{'picture'}->{$pictureType}->{'description'} = $description; $self->{'picture'}->{$pictureType}->{'width'} = $width; $self->{'picture'}->{$pictureType}->{'height'} = $height; $self->{'picture'}->{$pictureType}->{'depth'} = $depth; $self->{'picture'}->{$pictureType}->{'colorIndex'} = $colorIndex; $self->{'picture'}->{$pictureType}->{'imageData'} = $imageData; $self->{'picture'}->{$pictureType}->{'pictureType'} = $pictureType; # Create array of hashes with picture data from all the picture metadata blocks push ( @{$self->{'allpictures'}}, {%{$self->{'picture'}->{$pictureType}}} ); return 1; } sub _parseSeekTable { my ($self, $block) = @_; my $seektable = []; # grab the seekpoint table my $tmpBlock = $block->{'contents'}; my $offset = 0; # parse out the seekpoints while (my $seekpoint = substr($tmpBlock, $offset, 18)) { # Sample number of first sample in the target frame my $highbits = unpack('N', substr($seekpoint,0,4)); my $sampleNumber = $highbits * 2 ** 32 + unpack('N', (substr($seekpoint,4,4))); # Detect placeholder seekpoint # since the table is sorted, a placeholder means were finished last if ($sampleNumber == (0xFFFFFFFF * 2 ** 32 + 0xFFFFFFFF)); # Offset (in bytes) from the first byte of the first frame header # to the first byte of the target frame's header. $highbits = unpack('N', substr($seekpoint,8,4)); my $streamOffset = $highbits * 2 ** 32 + unpack('N', (substr($seekpoint,12,4))); # Number of samples in the target frame my $frameSamples = unpack('n', (substr($seekpoint,16,2))); # add this point to our copy of the table push (@$seektable, { 'sampleNumber' => $sampleNumber, 'streamOffset' => $streamOffset, 'frameSamples' => $frameSamples, }); $offset += 18; } $self->{'seektable'} = $seektable; return 1; } sub _parseAppBlock { my ($self, $block) = @_; # Parse out the tags from the metadata block my $appID = unpack('N', substr($block->{'contents'}, 0, 4, '')); $self->{'application'}->{$appID} = $block->{'contents'}; return 1; } # Take an offset as number of flac samples # and return CD-DA style mm:ss:ff sub _samplesToTime { my $samples = shift; my $samplerate = shift; if ($samplerate == 0) { warn "Couldn't find SAMPLERATE for time calculation!\n"; return; } my $totalSeconds = $samples / $samplerate; if ($totalSeconds == 0) { # handled specially to avoid division by zero errors return "00:00:00"; } my $trackMinutes = int(int($totalSeconds) / 60); my $trackSeconds = int($totalSeconds % 60); my $trackFrames = ($totalSeconds - int($totalSeconds)) * 75; # Poor man's rounding. Needed to match the output of metaflac. $trackFrames = int($trackFrames + 0.5); my $formattedTime = sprintf("%02d:%02d:%02d", $trackMinutes, $trackSeconds, $trackFrames); return $formattedTime; } sub _bin2dec { # Freely swiped from Perl Cookbook p. 48 (May 1999) return unpack ('N', pack ('B32', substr(0 x 32 . $_[0], -32))); } sub _packInt32 { # Packs an integer into a little-endian 32-bit unsigned int return pack('V', $_[0]); } sub _findMetadataIndex { my $self = shift; my $htype = shift; my $idx = shift || 0; my $found = 0; # Loop through the metadata_blocks until one of $htype is found while ($idx < @{$self->{'metadataBlocks'}}) { # Check the type to see if it's a $htype block if ($self->{'metadataBlocks'}[$idx]->{'blockType'} == $htype) { $found++; last; } $idx++; } # No streaminfo found. Error. return -1 if $found == 0; return $idx; } sub _addStringToComment { my $self = shift; my $addString = shift; $$self .= _packInt32(length($addString)); $$self .= $addString; } sub _addNewMetadataBlock { my $self = shift; my $htype = shift; my $contents = shift; my $numBlocks = @{$self->{'metadataBlocks'}}; # create a new block $self->{'metadataBlocks'}->[$numBlocks]->{'lastBlockFlag'} = 0; $self->{'metadataBlocks'}->[$numBlocks]->{'blockType'} = $htype; $self->{'metadataBlocks'}->[$numBlocks]->{'blockSize'} = length($contents); $self->{'metadataBlocks'}->[$numBlocks]->{'contents'} = $contents; } sub _updateMetadataBlock { my $self = shift; my $blockIdx = shift; my $contents = shift; # Update the block $self->{'metadataBlocks'}->[$blockIdx]->{'blockSize'} = length($contents); $self->{'metadataBlocks'}->[$blockIdx]->{'contents'} = $contents; } 1; __END__ =head1 NAME Audio::FLAC::Header - interface to FLAC header metadata. =head1 SYNOPSIS use Audio::FLAC::Header; my $flac = Audio::FLAC::Header->new("song.flac"); my $info = $flac->info(); foreach (keys %$info) { print "$_: $info->{$_}\n"; } my $tags = $flac->tags(); foreach (keys %$tags) { print "$_: $tags->{$_}\n"; } =head1 DESCRIPTION This module returns a hash containing basic information about a FLAC file, a representation of the embedded cue sheet if one exists, as well as tag information contained in the FLAC file's Vorbis tags. There is no complete list of tag keys for Vorbis tags, as they can be defined by the user; the basic set of tags used for FLAC files include: ALBUM ARTIST TITLE DATE GENRE TRACKNUMBER COMMENT The information returned by Audio::FLAC::info is keyed by: MINIMUMBLOCKSIZE MAXIMUMBLOCKSIZE MINIMUMFRAMESIZE MAXIMUMFRAMESIZE TOTALSAMPLES SAMPLERATE NUMCHANNELS BITSPERSAMPLE MD5CHECKSUM Information stored in the main hash that relates to the file itself or is calculated from some of the information fields is keyed by: trackLengthMinutes : minutes field of track length trackLengthSeconds : seconds field of track length trackLengthFrames : frames field of track length (base 75) trackTotalLengthSeconds : total length of track in fractional seconds bitRate : average bits per second of file fileSize : file size, in bytes =head1 CONSTRUCTORS =head2 C Opens a FLAC file, ensuring that it exists and is actually an FLAC stream, then loads the information and comment fields. =head1 INSTANCE METHODS =over 4 =item * info( [$key] ) Returns a hashref containing information about the FLAC file from the file's information header. The optional parameter, key, allows you to retrieve a single value from the info hash. Returns C if the key is not found. =item * tags( [$key] ) Returns a hashref containing tag keys and values of the FLAC file from the file's Vorbis Comment header. The optional parameter, key, allows you to retrieve a single value from the tag hash. Returns C if the key is not found. =item * cuesheet( ) Returns an arrayref which contains a textual representation of the cuesheet metada block. Each element in the array corresponds to one line in a .cue file. If there is no cuesheet block in this FLAC file the array will be empty. The resulting cuesheet should match the output of metaflac's --export-cuesheet-to option, with the exception of the FILE line, which includes the actual file name instead of "dummy.wav". =item * seektable( ) Returns the seektable. Currently disabled for performance. =item * application( $appId ) Returns the application block for the passed id. =item * picture( [$type ] ) Returns a hash containing data from a PICTURE block if found. Defaults to type 3 - "Front Cover" When the passed variable is 'all', an array of hashes containing picture data from all PICTURE blocks is returned. Allows for multiple instances of the same picture type. =item * set_separator( ) For multi-value ID3 tags, set the separator string. Defaults to '/' =item * vendor_string( ) Returns the vendor string. =item * set_vendor_string( $string ) Set the vendor string. Will be written on write() =item * write( ) Writes the current contents of the tag hash to the FLAC file, given that there's enough space in the header to do so. If there's insufficient space available (using pre-existing padding), the file will remain unchanged, and the function will return a zero value. =back =head1 SEE ALSO L =head1 AUTHORS Dan Sully, Edaniel@cpan.orgE =head1 COPYRIGHT Pure perl code Copyright (c) 2003-2004, Erik Reckase. Pure perl code Copyright (c) 2003-2007, Dan Sully & Slim Devices. Pure perl code Copyright (c) 2008-2009, Dan Sully XS code Copyright (c) 2004-2007, Dan Sully & Slim Devices. XS code Copyright (c) 2008-2009, Dan Sully This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.2 or, at your option, any later version of Perl 5 you may have available. =cut Audio-FLAC-Header-2.4/data/0000755000076500007650000000000011445140560014506 5ustar danieldanielAudio-FLAC-Header-2.4/data/empty.flac0000644000076500007650000003030311150671243016472 0ustar danieldanielfLaC"FR B !LY/z5ƬW?T.|YkYlYeeYb)YwQYpZ$YyNo }7 |d9aC2I32ZTL*I馉4d6*m5eII.Ⱥ;]rD77I%joHS.ݧ"tJEifKӦ\vV91DRxj+yE#H G' Audio-FLAC-Header-2.4/data/id3tagged.flac0000644000076500007650000007246011150671243017201 0ustar danieldanielID3!6TIT2Allegro MaestosoTPE1MozartTALBSinfonia Concertante Kv 364TRCK01/08COMMengberStandard - UberNet.orgTENC!Exact Audio Copy (Secure mode)fLaC"1 Bq:QԚW@m 0IR!,$,!6(D/SD6H]H=gH'CqJ9Q~#XX>+p_Y\e5lT(st:zFav Jj 3<,C: G=`U}$2a҈o=~,6҄ψV (stŝnL᷅Gr5^B!$. *;1IY8xV??8c=*F p4L|eS6Znima.5hnu|dz$[gSZ]+=8F&~UPdc"tԴat1F/wbQ*Ojى<fg p.  reference libFLAC 1.1.0 20030126 artist=Mozarttitle=Allegro Maestoso!album=Sinfonia Concertante Kv 364date= tracknumber=1genre=YkYlYeeYb)YwQYpZ$YycY~YS+9Y TLY ]Y ZY OY HaYAX YFxYgYYZB7~UjYUiUUZUTRiEʭV+JUY-rbR*VI+J&Lx+A xZII"e1$LYlLD2N$MՅ,*Ir* &hb(ڒvLaƪ2N\*ԣ ,qSbM1G' Z `N8*M;"!C Ag I0[2ZodTOt)O>ґ٠o!hҤOsMH 3t5e)M ؊7R$$FDm<#O !V(.dH8ߣSJk Kim$RO&bc)#RaFU2k "xq]IqBfeҤ2#Dq ĬO!"IKҶ>3VR$~"t2LЋNBTz"q w"JD#v#Ԩg2v4,z_L^Ӫ9Qa ""a3b2fh#gX#)m-"U!gxxA()dr>AcDgIĨ%o{0MD}HV1d5|2Wgʚ2Qzm;y$=dKvd4Ft.~GH>!#xa7h֐0Ծ, 8I$ImmiRjMHi&Ji&$.$,64O$Iu"U[mM&vK9%4IZ'%\ԏ&JM"|V#H9(9>\ʉ TJnQ4ȋbVa&[( ge W#F7f5eQ*Lj&l4 ,8Iӆ$EcC\'~B7ڳLA.RAELW &PgRPSB0(&T y#iɂcNeGT HW!sx#9 ~@1A;d8RєRRǭrIGw˳,baܫھCk싓|#? W^kqutr/nIcl(\(/&Oa " Qz4T[EBTK F)bĭaڹ8&,EMPd[Fd¦5]m%<#X<ȊCJʺOzBY1NLc3Жˊӟ&":Su?ɅR+R jiΞNuZE]cĬUO-5;Y)^Z1~sщ0ύ^*U+7z1L/Rz%7?W\b2WRZdK vb`ݐ@UB$oҞAѷE䲈5e5p_R/W՚u) BA2Y[*#R]H2*QDWMK$E`_e"իGO2Q8AXDTW$"k-_2˔EITe<;rOO[ZU5Se)!dB)JgTj|Ӕ:C? VPi޳Yf,2_DEף2ʁU7]mi!NeUA9KԿX˖[f2LU P`YJ*gц}u(sܞǩRYEcHCЭRPvDf\bkaO?CNJbpEB\oOŻfuQz*%՝Ɂ4%HĺJrJRH={$F)'fNlS2&Ѝ1]RDt,[0J6N0I,'Zd|I"K*F)t++5L 7us,b-1%['jʾ'5j%h|k|9vk'>B F~SaYh"T= w5^v&o1>Q7үH0|1d5򰏺x!#1TƫJ *NwvRΉ1*tb^[*F7i O7 /D7gwf'@ FJq !IZ`Ч%Ed"z,SSB"Lkη*E2Fu'ެz?RɤAyFgƪ}:(BJA8zhh5^lx1>r Vei*GY(@)ٛ=*{F~i> mu=5R/E.H8HuIeY,Q(Z*RBJ2]vw[#Gyw^!6ȥVQS2uјDQ K'`zW "WZ+I# $'EESk]fgz]ss9) 5(-FgjUqxiBhTnN"h LrlhOxlHaHt^rތq{ЅA+AFqEe yyFK-, 5]auOe~Y%֊6FSp^s+̾e)$ /U,2 Fq]^#b1*TCx!GJʚ 8&y{rDjHF/AI9T9ü90G)Gcۆ)V ) YVq5%[jnY/+tvIi{\=ԵB!TXy O34Uv߄iwH>:V@, +͓ӁpZQzhE+W ҈{Ė-e91&>sC>CF:q:,8AI]2BsHa(_F%L4͇<q(>JhYkM&FQݽhe4B /bUѦuJK&{Eyhv*ZY׌{CWunqh!{-4)iTvYz'i%}O:%GXSF9G )\7^cR^i2KR0xĴ79buTŧe/:RFe"yG V 4)]xj7FTԨ#ٲ֛/ bTL5f?[l9m j*CN BAYKK}jomBPINY7//F.6$%Җ\ۙ[QVEm%b e$98XI/vj~o'ֽ~F7 jW Ŀ 9aIYSl8ޛ?>BPyEyi4۷~R#+5__/662htB Bs Y) = k59e^Cṡ) RO]7Dg2lgr՚ïVz&sWJ?'ıDjuK5uC SK]_qZjE!zw/g'H$>L'PV-F)(O2oy%^AbL*\hCRNZ1PHPb>(>"#ztG~'N1e4 4J V!iӨ^)$Rd/VJsDĥ zN!CuQJ$b ӥxӛ flOJlqO ya4S'yyFA`^1s1h0щK'#%ǘ3o("b~*gԒΖ@]3- hd+Y e\`.giJ6=ckи$RjhĜ&|QVRA5X(.90E -WkBHB砋`C'з@Ha8Ĉ C(%–!|q.-D]m$P P0Rɸ4 qC uyx㖎~<_%Z)9^QA!,SYL=N +N5#]1M/'Uzǝd!8JP `hʹ2CT$ 8h硨&bG-Re4BG.ȧ c7)MC\Rk,tyZz{DO$(Bd`wGQQdP+SV H,ۉ[r4W0Q(,pZʸ'ssR4 ?Q:8 QP4‡FiH 9si1E^A(| G ޱbuKJBtp JZ LjhU-u2 5pS`!tvWrgõtYsvq75.,@v,B!SW SiFřBJӲ/57 :eP/uj%E8px:%[$WXyh݃ 7F]"'I M5xLamI yrݛwl,︞c kGV@[엂R/՝-мFxO_}P=';VNT5@4u"%RZMrJʮzh8 7-𪋭x(p՗vHUA&N8NeM@WcT}5y ]Z'I{:f)VƓ(Xv%sm攢A,~( ^71TI' V/fxP6=qh-'E7~(\Rx"hQl#Z%eU 魬VDQҹU藴[,VtYL.jYu˹&;7pX ]ݡ^,J+::EQAh"Vu+LJ0t۱4eJq_4mԇ0/]S2N8E!SkBh}:6R 7+n~uPνr*jeS3AUM%3GH\I9\WUEj&2!  _(rk?4W YHe{H9,T:hA~0 Ql*,]Iس ,*>iQثhu ɞ َ]*KWtڄgf1gC8zDv32PΔIM,Q&;}ϘO_tзXl{ϦV`SY< i\4i:/gɠzoZU_Ylli?$gsYv>v06HFhْO^pe] ۺŒ,1A8ܩ8y2RSxQTQ軆!=Ʈw ѝE:Al#XS2~Kn NW.-w8 yfB+5/i2Z(Şg=RQґtEL2RUdWRRn_9U$|bqu svy,c)JE*܈1 (>68MGRAw\]#FE,qP.ߑ{ooʴuˆ-9h]_jM8c:SײSpፋ-VB9:O#$yUjAu5& 8~[fhҴCtm1i-E9TY˹WS[pڠ$y(ayS^+NSӃW؊ڿuuMH:M6m%EiW4mwٳ䴳Ny*viݯB=M "$i%ޔ>G\rĊ9"EWCq**%#,P3b`pEMֈtI&uhUvQk:hP@{Y>@N .KuoFSkֵԖA=p"f {^MӍ-+".3*No$P *, Y{mnX\!"C2EeuQx^p&*vVS**>|"TIbٸ?OXAz !'j~ ؛a0Xtd@*]FM B%]N BdE+ST3l0._Bt#'[,B}_,m"Ȳ 8*#)a{4>*1;5wmIY-^l,eȈ,l؂-0EDi[@M@L \Qe䜔5-T+} DIaamސJq&eV{,oȂ(7VAWw 1'F* JܻB UlAUߑ&Bž2#%*`"@vX/,`6D.!=qgc*Zϒ&Qq6Pڬ `YO"2l*B"hYi %Uѣ ̸7NA("dz~${@xIeP+?aUEp=&*<:jljojƾ,F&8(‚^hDEWK`X>BN LYC?ňk 1^ ne q\ZaBw'(c Ӕ)~ߋ&MQ]:>L[*GdfhGw⻲mK%L!,ݙ,|6VrեM0OR|EV^ B _X'+E&w Aڵ \v xbPN'XQ8` oŌ6a /#S"D;Mg<ѸN* `_,e`a@ Uzӛ$"͸$L#j,1 Df_s-Rz>KwC Yu"$;@Ha0k Va;Z025u#ZS5c]CU.Hdse0qYn2҃D"T[(tZ_CFάF=!p^:Tm7u `/irh%L7\]0hsPy_5  0ULt7x (丳ˌ(Ug=a3Q* XT,lUH)b 97pK_&&'W*lrE`Q< US)g$`bsogr@Z*ic$z;rNJt2&Ȓ ~/ ОY'2SY/12 &Й #6LC^؂0I]8(7D!_lioPKd[[X,@O|M)2hNjqĄT nkb?"*ȘM@,aD5 Es &_i&QTXOcnl>!:]tˠ!(妏_8]s~ПwJ&V|đdGE*LbgQ2*6uox[D4DZ|A\B2/$$<`EPqr<;$gF#J":DElߋ6CG94T"e %${ 1V~JW8 C@"2"@z b|ܱ #aKUl;Yy~btp|\*@讏V\Q2Qګ{wfy+4AE[9-Ddv4XʗG. )/=!i ?'OC82Uͼ=E A6zEEweqcc 4t. pc[&d\"-#ph.{]E)p6i uMNL7w.SPK,iQv O"U<IAKZMCH!}%KLhA%6nČ}C;tC80p;ӼKD+oxHc%db]l2"=dAd$7T4ylbɚL*߉҅A$wBț\XL)gMvL>%cvӯ%CRG**M+(QHA?gU~RRx&0G8YEI!8 +bfj UZ'U2SW]V8X$ ͐ei5 SO ׂAly]Q0,@yG(Me4B)*ZDj0?L# 9妩G͢I. A<.9|7vTcGKѼy{0F9Dվ{'ͦ\ajGʂTFJh`ZwK2j#0,mٞf.%`AH'b$n`0uxn#ӊ22Z $¶00\I!9Y=tYr7e$ $7%r 8/īzahOe u>0D8图.IW:#j- }Al l􃫓(2zqc'RB fL44c 4V"EF>:yLo$ cVo!bMs!Ee)-}x7X Yzt)J|kb-i`ㄦl&#h4 R(XbpnU i'sPAɫYDlaeIt_n-ag'1ZEt.Xa$,4lR~"3A͝h[&ݳC>*+6D"1ƌduB Y\ftE7.UAW *_ү'jUD-Ǧ8Q$OQFbC1L)@׸/\>xWVrG07Zʒ5iZ4ql! m:ķ`Ǩue%U|/a˖a{ r߂((c/6 ]hhLqw!:_gӄ\,&3*QB8"LūreI" 1ݑQRyLj☚SPc]U7 L+N!eZ62GCk2h&-B,] !"vܖ6aˋw#~2ƪ:^T 4b r"[]hs@ZO.֗3(, ffW2H(Z6qmE v"pDwyFǖaIP)z%kWUwȯ!>=xĠǡi hfA[ɽ8ZQ3JF q-RFRhUH.-)苀kv TV!QKi50S"u6geƓ]R.ܣaeEVDȇȩO0iL FXr*Q aP(>mH Bh !$<`Zzq?3U0%UHRX@l>숝 |M0FC|tBigmޅU" "xƓ$6}L S{z9ML44H& (~nbNd xhRrT貪No|tzmKdYB.UT7 qD2G*8pl$PU֢&Lh F.2XtB." \db O-fHYC%"s_]mLَtz]:ʍ:I6IZ 4qUfE1 `cQJz)ЎϛԎyOI(Y3'KRiL5Q@^m(1_'7pW-(b8"cBy/.L 腙X:5h>6=C3, (jA9;X QO% ab~erNÏo =%0^`T!akj_R@r>Qe"8Q H;Nl,zL6Ԣ T>v؟'0"SLļ?6HPȖD1:ϭ 8"%HP70&I+848Ѩmz*0tA,5U6.̛EJ_L$q-w Lď`8%|YNl ءMǐZnH'WDJ} a!3&"SP!۵$![6 hlO廱&n ij6nqBIhq|x`IP-m/ve&l`9ek"D({-+ZS]pHfY钽2uzEFYe#*dm̖i 6#We 64S>6CNGl{gǏ$xvLm@fA<=:7mrMѝaIF1B,g*_RT)L\J(}UWBI.>UL\yʪqŵFY'-OКvL!ɑq9.&FH!^2_ ,P؉Q wPkCmҊ})* Y72jaQYexyO~ԅ uzSJ$"g"7"QlqGdm} E_N02pdL7{<8Xm0,iuӭ? 0?8(dO0ZC&ٷa&{<1v(i̊:rk#k5M21[w?@y YȨI˽FiD ա0>ܹa (YF""BŜ#S~$uhvݏ :ddFq)H\5#LES/12Urq^0?*w 7< )F0GM $=}:a$f~Кw1KaR(f&XWTTiW"B/-̓DϨNF˂ e5MYY$R’*1 iUd*hk4aIAEޘ}aդ#Qs8jؔamATW)m%T($[Bb;YڬZ̓Fb 2^sXf SgE']9nF*eeO[ߛaNk} ~ b]˪g$9:#L ؃g["~0H>3EcM1u_FX,6q|-%hm7uնe* /T|WI8?Li E-)q2\ȥ9t[iLJ-y2"3[=#HKfes?( KCf̢L9= 2n~yHd#XHa^̫% DXmFq.[(oX0'uͷ{GDw9h yћwcQFrkAƏI}wdѠ[7e6r u[\b{6hq5QX~DC 8`pq6sܕ #k=w #7$۳@{mVvu"tH4$ʉIP$Sp׎vu>{U8 lܙHjϛMAudio-FLAC-Header-2.4/data/appId.flac0000644000076500007650000005730611150671243016405 0ustar danieldanielfLaC"49 Bqt6uv 9 {w nx.'5P!D(nRzK/.`5n<|Cn!jJ.JPlW ^n`e.ܧkՓrGy\&!=g06\?DNe^oG\~#yÜ\#E wޜ*\%%DfFJ/I >k M]BuJmn" }(j/*6J&>= C͈=JөQJ X @^ mel8(r7NyFxUZ Y)_<Z8[F>g;s OK OK Bela Lugosi's Dead Bauhaus Bauhaus Bela Lugosi's Dead 579960 Boys 191040 k7Uujֵ~UZՋynu]]UUWUW~U^5uUZU[Z޷uUU_=j~5U۴UU__VZVUV[_Uw[իꢪZUգZUooj߾Uj^kmUU]UVUj^꪿{V]UOoֵ+ZW޹wnVoڷuڪUkUkVUmu_}ֵ{zUWZժUzj]j-Uիw]U֪֭~]WvUz]ꮪڵU~j]]UQWU~_z]Z[UjwZ~ިUVk[tjUk=Q}Z^V믿 kիUUUe_WmUUUUUVjUEmZZڮ[ѽ~Un*7zo}}jZUWVrZj5V{jUUuUZZjU]U_ھWYW+Z[nV{VW޻UUzݪ]uUjպUZZWk7EU_nmjUVꪻUWkWmzj~ժW~*#m^V֭kV;Uꮮjmժ۵UU~Umo}ꪭUV^z_WummUVUwW֮Uբ[zڮVG}.Wu}z[UWZު_ںW]իu֯Vmڵum]]][kjUukUz_ֺ!jUjmm_vUuUګ=_j[VUUn7^V߽[*WE{_Z]VZUU^vZUUZ|j궵JunbꮺV޷*U_ʪUUU}jk]jVUnUUj^z_zUWVUzUuWjڨ{ZnVzU_U꪿^ݪUkzu^VU}}֫v[ծU+kjUURU~uUg~UEWuUV_vڽV_u_{jU[ݭUVU꪿~_UZuv~}ZW/Uk{U}իU]l*UQU}UZz_V^{}Uj[V]ZvZok֭_Wߪ]U[][VWuzzWWkZݣ}_Uu_Uj껵*kVuUo굪Z]j]UWUzj_U>o[UUk^߯uUEv_ujUZ]_UUUW^[ժ~ƪګzWUzZU^_Wu^UVU_U}UUZjUhUkj^TWjժ}]]UZujժoU}/WժUZU{UϭyU]jUV]_o[UWmuwU_WUUuWjUڿ]Q]Uk^޿UU]UUo*oUW@2Yl/ZUUuVFVj֪WEU]jUUUֵ_^k]b]VUUjՕZU_vFڪuUZΪZQUjUZWmWꪶV굾UZ_UUu^}\]V*UkUjkUYWUk^mW]EUUVQm[w׫jZUZu]WտUUW]zUz*UTzڭW]V+Vk着WUU۪ꫪu_gVֺWvUWջ궽v{[VkU]]۪7UUZ[ׯUJZUZ]W_۪So[UW_ZezjVEUjڭUZ]nu^nWUWک_~ QVUꢪUUUU]ֺ꿵UVouUZW[ZuUF_Ulfz{oWUZUWuk}~6ݶZժ׵^kUkjZU_UmWF_UwuTW_U~}+{-{*Mk}U}VukUW~WUuuUkUju[mzxU]UmVUUuUWZU[UUUUZ^~U_mkսYZ]UZ~WVUյZzW}{^SWvUWUj~WwUkU~ojֵUWW]V]UWUZVuߵU5WZ+_-uwzkVZ]Zz֫^ފߺUVEu]o[jڪVWEkj*7Un궪Uu}oU]Zm^꯵wտ{]uV^ծUk]Uwֺս׶꪿W~W׵^u^UuUEkVu}UVZUUEWjkU_VUVQU^jUj׫}VzjUުU[^ZWZ]U_vūuWkjUt~{몪uQUWjU~Uu}WUU[sW_nWjzUUeUjj*+^_Zjw_UWn[_ojU֭UUU]Uj꪿A}U^oֿU[^Ůݫ^^UWֵW׫U{juUUZjuWWj_Uꮯ}QU__V_kn[VV]mWUW}nkuUﺫ}~Z_mUUZc몿U뵶mX^j޶ڪj/kꪵުUWUEk}UZ*UuZnWUV[UvUmz׵WUUwjUz.uoj]^T~ZUuwVUwUVj_UUWꪭ_Vu~W]UUUUWQ}W]]]WmFZի__V]oTjQ~WVjwֺz۽ڿ};YeUվzWUn﮵UEUkvתֺ^UUZ_ZV}j]QV߭/UVW]mj{uW]UUk+ju_WVvU}j:UuUk]zU~ljVUEVVUիmWuZkoѶjzkWwڪUU]UWުUUZkW۵^ꢯ֪z}UU_Uz5z>~oZ[nںʪVZպZ?wZUW5UVVUUUmUUVʪ,Uo~jUZ{WzU_TWjխk[W_U][}jZu]׭GުQUnW^}zmjTZmUjZzZVگwUjuU]V}}j׭U]Uֶo{^UUUo{u~VUյ^mVꪯZu^ZժUuTooUcUUV^꾫mW]]׭UUVkUv^w^Zֺ][U]jj[UuW[ZW{׵UkUZwޯZ_uZU_zUuzj]zvת~vUUZ[jέ_{VھꪪʷUUUU_Vگ{^]V{~֪Uw~vujU}ڪjժU}UnoUuZ-jJj_UQUUUGoZյvꪵWWzm[ZW[}uj -Z}ꯊEVU}u}}uUZZ5^nQZ]ڪWʷZZZ?ڵUj^zںW^_[UZjڿQU[Vg_j_UUUUkWh~z٭WUV}UfU^]Q_zUV=^kTmU֮u}j}UjꪫwU^ʶUU^[kUZjժ[[Vo_kU_U}WUqUw{WU]UWzlj?hwj궺W[kw۾j]V[֪ժ]UT~~խ]zVUWUwUmUnUk_zW]V^EVۮUKխUEU[ꪭ}{~TUjrj.ꭺժj^}_VU]kU*vuj__UwEQ[UWު^j}_u[]ʶQZu֯wu}U^kU}꭪]U_~ՎVzڷb{ֵVU~Uu߯jUUUzjZZum'ZUUjꭽVWUVVw_wU^QzUmQZ꺪UU]_m_z#UU}uUVok]jUnUm궺Z+jկڻEZU^]__꭮꭭VZW}uEU{_YZ/Z]WjUW6ꪊWگZ{jjWZ֊muZjzZ``Yb7wzoUVuoUZZvڪUuzֵ}UUjU[Ukj:s^vkVWuUmZZ_ZUWVuouEu_ujTjU[uUWvzZU꺭nUZk]jY{*_UkTVꪭUZkWWw]Zu~+jjn]W}UUWگ{]ZTVޕUzjjjսZZU_}UUWUU֪Uzխު_U{UU[_UVխjvnVWV^|W~UZ*UU^qUJWի֭Z]ު]wVWUW{__[_U_UuU^Zյ[nګo]ujUկW|UVvUuAUj_jگWWoWU]Uuתjw^UV*uj}UZ+k_ڪZqW{_mj^׮ޭWVUU}ujUVu[Ujz^Ukյ^WW]kϽWUWVUwkUWUwҪڪj]WWmUmU]ڮUWwm^իֶ]ujUUk׵WjUUUZkZWU~wWU_w]kWZUUU}jVUkVUUjuU^n޵QjWպ[kWUkUUU~Vj׭^ުZ몺׿mUm^WjW^_۵WUUUzEU}uUuVU[ު]UWը WnzڪWW[{Wm[[z뺢Vz^VUz/ִ\]U][F_kkUu^XUU蝹Uumگ溵ZZjޯꮾۯhUTuVzڪ^j_T_jujov׵UWZޭkjZjTU]Vum^_U֮WjkUVZUUkVz+okomkUU[WڭEV+۫oWV[W]VUUQV[ֻ6ꋺڪ-խ׫]kmZ]uUwZVWVU}ꪪV}UV_kWWUWUUV}UW{UުjUj}UQ_{zZWZjjVjUUuU_U^}T_޺5[mUVjvWnVWի~עꪽ_{ߪ}ZիuUWV-zuWUVڊʭ_W}uQ]UQZ_]}jݻ~}V]jmTZjUj޽ڪWVU^jjUWU[Z]{U[]mjUrW]V?kծVUmV_UEVQ}UگߪuںWoUU]UzUWuu]VfUUwU^ZUW{[[vU~Z]VUj^j}kUUuUZֶV^V꫻vUkWV]ZmZ۫׾UjpYwj~WVm~T^7}^{֪ZW׳c]o_UW}UZ[U}QWuZU{z[覆j*V[uW^ںUUZUzj֯QUެUV]ZUWUm}UVMU}]vUWUUUU]{^ʶ]V^UWkbWU*U}z֪ڪ֫uU徭W>jުګUUWU}W{kU]UUwuw:_߹WUUzzխuWjڵk[~ݨZjvWիvU[kUUzΫյUj׫Q_۵_U]UZڵkvպkUUkUUꪪ~]j{^}UWUmU׫hUUj_^z}^WW{+[UZUU}*UjUVU\uU꺪~vhjWj_kUEu]TW׮ծ׫UjWkժZUZU_^֭kUu_eWfVVzoVUQWUmWWjUUQjջUjjjT~.zUnUڪ[kUUu]{达W޺WUz[j4UnUUZݪuv+Uj]UzUW}WUW{U涫ZU֪;꺫}UwڶUU_VTkU[u>+jUUskUUWuk]WVޫUwUkmwWu^}E{ƪ_ZZu׭UU}[UjU]U]_UeuUWUmQU}U6W^Uׯվ/EZjnZUU򪪻V+UkUwZu]UuU]ھ׫zzuW_ڢUU{ݺ:իWUU5jz]]oꪺzVUWU]UUZվ^^Vkz*Ek_UUjn]]Z{Uժ*j[uUk뷪/W[ooUVףuo]uU֪UujjUzuZU^TUTzwU֫UU}UUڪUZznVʭתj[տ~ZZud7_}{լUZZ]]^mU[UkuU껯U_WoUX+UWVZhUUnUjWW*־Rvꪫ_UUZ[Uwu֫UzWU֕}ڷZmmVUuz^o}j}UUꪶ~n[_Wuuۯ{WoUﺪjU\_UU]kQUzjھj[VֿUnZ7UUWնj\շZ޶]kU_]-VQW5Wju^j׮WV]gWUoUojUU[zUoZWWmUo^V^ެUVUUWޫmsQUV__UmUT}uhjj_襁WuUޯUzwWQUo]U]W-^*WV_V^U~UUk쿫z*UkFYpUzUkj֯uwZ6UYU_{Z_Uկս^ګWjU[[^ZUvU}}zUkk겷WVu[Vw]WʫVUޯmUUWvUj]ZWUj+UV+mz]㯯WWޣjUWU^j[ׯu_Uk[Z{Z^oEڵ֪zW}uuj[ZU^ꪭVWkjڭoZ׫o5UUU*7z[ZVUժUUVUH֫_UV[UUUnר֪ժխezVj~VU]_U~U___j򪮫OުWWnZVWUUnڽU_UjUj{UW^*UkߪUE^U{Wh{]ZUWUUWQڮխmUUUU:ujU}kUU_گU}UյUWkznުZ^ڪ_uUں^oڪF{ZꪾUUU_k_Uk֭Zڮ_mjUmZ]UwYV޵WjUk}U{[wڪ[ުj_W^ZUUUꪪUk]n}uuzڴU[GQWzuQլյ_kVZU_UUo{VV?njܪUmzwjkuQVouWuz[UUEUUFUEWޢk~ZVUonjTUw]ߪުzߪkUo^ڵQj޵^m׻W\uum_uj֊UUTQW]ZUfʽUWUWW[wf꪿ZUﮫ_ꫯ_[Zꪯu}Ujw{WU*jWUkUUUW^ZZUZmkֵW^kvW]z_UWVV檵WU]UUUUZׯ[׺WoUUWjwUQUݫUZWwjzUUjzگ׫Q^}ZWV{zZUUwEUUUVUu]nZ꾽Fk}uwUn^kVVUwU[W~UUUQUUڪU_ZꮮU_}?juX꭪ժ꯷lW=WUE֣}VjڮU{uUW޿o^Wj~UU֫[WUU_Uujumծm_VWZ]UjUkUww~{nꪵ_n֭UUWWڮ_}UWWmꮽjZ]{U]U\@ۿUU_{_ծڿWUWֵ۽UU~zU{unj~Z]YVUUUVoʵUvu[կ{~]]WUW{UuתWUj}T_VzժUmVjU}}{h_VUUխUjGVݯ7_UnUU6ZUn-unQjUjתWjuW_ZW헺ꪪWUUںZZޫnUj w{kuW(ߵvmvUUz۵U]UޭZ;wZjVomoUz*,׶ֶjuU_֫kZuZjZ"?_UWVտj[koUVujUWjֵuU]}]V_jݪꪭW[U[ުuUuꫫUwkUZuw]UU[ݪUn]կ}V~ޫU]ꭵ~Uꮺ]kUk^u[W~UZګu]k{VUꪫ]nꮪVmUU޷wjޭjUUUjoժkzuozUm]UU]ZUUUnuoWU_k_m[UUm^}Wj]^k~Wu߶jk~Vھ]UkuUUuUU֫{^UVkڪFUwƭժzUjWnoUz֭-{[Ux{ժfUZY~UwU?_lꪪuZnmU^WW^EsgUQ]UUW{UUUz"VWQUW:+ۏjWjU޷Z[ouU^Un_^j֭^ݷZ]UzVmG[]juj>ھU]]5kUU^^uQ[nռU]VVuz߭}UU_V_~UխVUU]VjֿmuUj֫U]*TWZ{[]nuUWZUmZ޻]mWZw[UUw5Wmzjjw[WkWmUk[~UUUUwmF._Vz߻UUUUUUU]Z^UzTjWu]UZj^U{{ڪ]uvuj^ՕzoJVV{UVԪu{ھ_}jյ]][~UUڮUߪꪪ\uUjW~_UW׶UU]WZ֯֫WUUU[U]j[굮U^kUWU]znWZj_j=~UV֪VuEZתꪫkkqomU^UUnmUVU׻ꪵUnUG[^^]oVuUUUZWU֫]Z[꺭}UWuWU]U_jڵUUvknoݫzwUU֪Vj*U~[UڋUkWzZ_ꢪZlUEuzU "ZZUZ^;w7oWUZUjUZ}=ZGުU[jw[V_תU֯jժkUuժUUj}Z굮Zjꯪ}z{_Um_^UU֯Uj_}[U]}UUZjZ}^_UUWVyUU~U]먮_Y]kvUV[bUUEU.jz~_Q]jV/z^^uZ_{VUU^V׽Uno{QjU}]UjzWU{\UvꪵFUj޶ݪzWU^}UZ_utVWU~ZV]_uժ.U{}{jתUUzڶ յ[U}W]oꪶTjUU[UU]Zz]_]^Vo[wVuz꾫oUUUWQUUz׵}ޭmZ/Wj몭uTZ=VWjꪽV}Um]MZzֺvwk[}Tzڮժ[[UWwUj{WﭫUjޯ?VU]jVZUWu{WVUZwuVjUWuֻoV]ꪪM_}յUZZWUUuXժ{תVUojVjU˷_ok[UUWuzV-onjW]]xmkUUu]zUmVW{^ڭZ֫WnWV8YS߭=v]}VUȪUW_ZUhEVUzjVګ]W_U_f^V+uUUujVVon7ZUպUw]o֪ꪵh_VݵFߪ\ꫯUGڪzu[vZ_/oUꪮuZ۪mqjkVW֊U{}^WU-}tU_~뾫uUv]UU^ZZWUU^V֯ꪯ[joUU뫯]VUWjUeU5ju֮joU5u}W}ZVuUWVzںUZ]WuwUmժU[ZUu_UWkVWֲZ]uWVU_j֫ZzUW[k_uU{_[jZj_WW{ZZmW;_UUUk_WU^گ_Wo_]ުUuWv]{wUVwUjjuUZ[SUի]Um]UUz}jZ^շkUUjkoݮ꪿Uzޮuz~ֵUWޭUuEU]UU]ګꪭUUUޫkU{mUVZ]WVz^mUUk[W]U}뫪[uvmz+kUUo_UZ5YUEjV_ڪ:UUվW]YkUU*VڭV_խ_oUZ_Ujv׭誫U~^}u]jگhշUUڵ]zhUZnVWuZZuZ?j:U۵UվmWUOUV_ʭUZ-T[{~j_U}U>ުnUVkjUUիuU{_kUj[_jjoUEWU_QիjjǽWWWVj5U{.]Wj]UEUZG뺭ZUU6[궽uUzn^Z֫ު+Uu_TחW]o_s_^VկkhjU]jWU}[jUmڪUTnު˪}_jZUwj۵Z[Uz[w*jjUZ=ίuku[޾UUֽUUkګjUjꪷWm}{mUVѯQVVmUu;mZUn}UWWuUU{ںZU].W^+U]^WUUVVUWUѫ[ujjunꪽV]UUU{ժޯuVZzUn梫uWjj[U_*WUo*۶UU[_{UmUu^UZ[z^uUkwY[U[jm~UU}wmעUW+U_ѪZ^ֽkUV_[jUuUuVjUuojUkU]Wj[VWjm]ujm_mW]_wUUگիUE{UW]^Wu]VUk^^~VfbY TUWUZUUں֭ZUZUVUVZUU]j{U^Z_^mm]uWzU֪׫UU]ޫ~խ{_ZսQ]U모[kVnoz_^wVQQUWu^ꫪ_WV]oUmu~uU_ZZu_WzjZޫ\]UWxQUUWUQVWVzjU_kZUk5׮յtTWjյ^UUQ|]_]]uUnUom]FUV_mꊪVz]U}Z]_{WvQzVTjmU]UuUW]v~ʾZUj^۪6ֶUwQUVTWjV۬b]UUjUjU[V۶[Vڽu[^ի{UjZ}ZUW^{[VV~[UZUUUyXkk_]uu_{UzӪjwEUQUwUUյVQmkտjʪUU]U^NUUm{۪VZ}UUUoVժE{]UZꪪU]Wj꫾WWWJUZu_5uUknڪսUTuVڪ^GUVU^ֿZGkV]mU}[}UUUUWWuUUuUZ]]շUUmoz^jQuuUf믵zUޮjڪZUUUuZZ_UjUVT@*uVUo]VUW_mzZ׷*ڭ{]VjתwV}]mvy~u[բ*VVuںzjzWګjڻzwUUWƭv7U[VjYW]V~kUk֨uޢ{QU}}Z]jUUګUVګWU~U]_[_ZUկU謹]U~ٳVUQuUjꪍ[jVU]v^kkuUnZUzUvU[֭VUzUzݫUzj]U꪿kŪUTUZjoujmjUo]nUUW{UUzZ^_ֵUUwwUV[]W[^WWF]wz(muZuZZjwڪպQjѫWuU{VT]kEkUwUjժںW}j.FhjUUU_{UkFU_VֽUUvպk]uUow[֢}UUUڪmګ^WjժkU]vꪪW{Uu޶mWoVzAudio-FLAC-Header-2.4/data/test.flac0000644000076500007650000003030311150671243016313 0ustar danieldanielfLaC"FR B !LY/z5ƬW?T ~ nض.#3I!B>(\Q/c5wr<C\3J 2Pƭ&W9^Je }krx*٠y8?әTi#f,xxe&q@%fǮ&- T_*d>ׂRBdDstoq%B%M p^`0/յ!n(^/'g59ή<LAVCL[J nh%PWT^Le Gk`rzy:2C ڵh ^(5cIܢ^*oWho.oT|VdLϚׄk*DR*1`2=Q'd:L ruj2!(`S/ =5<A%CN]JP%uXW8(^NKd\_kmJ r|~y<~B2b Vj3*IBXgݙ_)X1E@Xe׆lBRF*EtEs4 㟥R2 t ["51V!=Ev(bJe/"[5oE<i\CPڗJPEWG[\^>_0dk~r~y>  " 67l I, ]> pY eZ / x  ˤ6Z & UI 9׈  H -4w ? Ov `<6 t~:   d A$  _! w"| 5m# < (d )n/$ zM5 V< CR J 3P G"W Zg^@ nNe "k ?r y.  ф' 'Gn j. ZF Y 4d\ H H [ o * x xJ # ;a ׊ wJ > ׯ ;x $8  6 0| f Ar7& RRR cܣ! u(f / y5 < CT =J P YWe^Bbe%<k7`rJy0[Ql@y8zҾXzӾp0͈vk^zSBӥL ({;J׌On:b,umԾzqD:Qjۇi 6u% hv5 v(m+!D(V//5&<2_CVBJU2PhW|B(^DYekPrry2⊮; rG /> K7`W hmY{lN%Z׎< X |4h<ELSU]RG jjWz*xV!z(X5/55<P!CXJ/gPWW#^F7eLzk_wrtry4qרb"ؗb BW$P99Mfb?~u> IzD~),^9^ڮ? l,87:!'n(Z;-/M׺5a[<tCCH'2JwP W^H9dDkrvy =y6 m{R M$z1dCy$V i/{d,$|ȺRuR׀@-:=HO?nd.xs  n .> *hX o *~@\"X >`# AX @  y P !Lf reference libFLAC 1.1.0 20030126AUTHOR=Praga KhanALBUM=Mutant FunkGENRE=ElectronicYkYlYeeYb)YwQYpZ$YyNo }7 |d9aC2I32ZTL*I馉4d6*m5eII.Ⱥ;]rD77I%joHS.ݧ"tJEifKӦ\vV91DRxj+yE#H G' Audio-FLAC-Header-2.4/data/picture.flac0000644000076500007650000013134311150671243017015 0ustar danieldanielfLaC":C Box}T*]  P !=3kE"Y`)kiU0}}7;>iE LVS AZaah .#reference libFLAC 1.1.1 20041001lac ALBUM=Led ZeppelinTITLE=Good Times Bad Times GENRE=Rock TRACKNUMBER=1 DATE=1969ARTIST=Led Zeppelin REPLAYGAIN_TRACK_PEAK=0.99996948REPLAYGAIN_TRACK_GAIN=-6.63 dB REPLAYGAIN_ALBUM_PEAK=0.99996948REPLAYGAIN_ALBUM_GAIN=-6.19 dBa image/jpeg-,7JFIFC  !"$"$C,-" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?􏇬y#c@7zil-f${[8BsNW; Y+dg(@+$`9#mA$U!W'`z`j88qos˹nN#Ch=>-m-q3r~]ȍnA]>of&2H78FqW/ݴL6mEtp/A 7rwI,BRDI'5RM'ӭJdLEr2F'w1qG+l9,ۑ $lf݃28]yefI$KsQi]98 n0p2;GwYM22̲⛔~یd 3esE4yLj\!%Ƌdnq~ЯFBA ij;ʰܓLZȌ MsqԖ;])%'Q `>Q F3Һ+;+[.Ch3 ؊A]ǫg洇؉;=hc#+]Z"1 vs$p~%6K'd[Of\Gϙ޳e ;-6;kHV^i"WjMM `q{+ϼiN5\ W@H$=tKW9WkǍ `pE1O1Cm')%x,mr Qnipd R>lF4.)'z/frP? ҝ6ٺ[*,aI (P䜥U9#Z^;|6G#pG\GMKkiqe%o,4Y9(^kv|GA-Y"2&=p8ә F͗NI&47J//#fŖGٌ0/s[_5KY5{;O:;)$-#|HBx8Esqf_yah"9L21糃G{Q=yvIeEfXgksH955wsJ#U&&ijd1y},n%BF㹹j;X;[#p,[9=gCm,-pP)iœ瞊twׇwE H YX{WfRj+B=ܰ/ OD͆x#یv'I6O @6F)]mi^y%t[8#0H/B{XfX-2IW?Q׈h'f=gCҬ# ^Tl(m98AwVnM?“۩(ۯ ,9nhIX#EFL@9lI?ZgC v*Köe=7j"ѭ:J$J+>+=hc]t?0*☜cj_ 7szW_:2^F3K,Gߋ{ϖ6_V=;IM%="|As muU8g'@3ú~kT1[FhR='v{7t+{[ScR6O8R['/#%H^Տ~wZ\4Z?j3}u(Up}3֢K]X)}԰H@rUja#I"3Iּ㧃jqY:ڕhݣ*J3X|֬4]>[Hx[뉧D6ǵv3ɹ\m#\V؋Ǻu׀M B{q 7=}=fY0ȒZHHd90gWџ5}*KQ^)Q6H#ہWோ|욮rрg!%39˚=ݞFQ5 JGM\YOr3szA<íK$Mddk9OqxLЃUa?wCFIffﺉ;ОO? ݳyZ.Zyqo`VY^U6gc:xAxM^PyM2/4!ZsL:s9P;.} =g)Rz5{Z ^jHpߜ:kF񀤑ӽxWf=bI͸m5W_]/TuN8r\@"[ {JZe4zw(dc;4=:ߥT!Ϙf^xOïUoW)mgT@XHv$6{aSy_Rsh[ qL_2 7A ?QscmrH3Ʊ| S29??jeCcOi4]fV7(|ZoB4.'=^VDBUWp<1@w. r2pXF21z°/-U]nŲp`8>ٮzJƴmL{+TxmmɒhnHWA#oNf}`|Sw1?@:T+Cw3˃.'ӑi(bA xD- ܴbj&艒dŒ\\ ;hReH~\Af1N9gU`bQduѿ+E0vZ[́&ҽWRAOQT" fhf6s)^Ui3WC֑dK(-֖ +)x ]KxR6h(v Dq~c N  ۷?ʾioUY:]oOtutW6#0v/$85]1yȩIL|!Dx^ֱk<.#v8<}YTE-#s8V%rq'*yat{W|͟S} !Sx/I 55|Ӛ|~tyG>YZhy3RX6^vO$(:PP5x=;%xfrIs~>8r$})&9bͳJ#@×uj_ ds.忖zmƓ}OXNs1V,\9T 9+/>ZG/uM 5́bSmx[3+ i(M=u#ٿc I{kqk$:U˲R(PH# d_eØT?(+د_դ񆱡^Mq4HC^$YvV tb,1)Y0Y~^* s vx!-O9Iԩ? f\_$?ɨ8!=pOJI@^5 ep1\Xhr> /ϙ¼H@I :`}=1[b.pmAͱegw| Đ9t]ǡ<׮t^iJ@"kn !zqPJBҸyhET,GyV0@P;/W0l5[ B'?muGlpzKgL㑳YPA\}cGm %$9sWCC (me,jB7X Yc6y8MhIcg`?6Fr{{`VTiqHu%= XltSy;=,-Q{|p=zT'̆$X$ *<核"{MhlɄ}IHȼFs8y'Ŗس0?Ȩț `UgՖ9{yWx^CL20HdIrC(SLVJ,2@9c\Hy Q\20_|iyc̸gفbܷҾEk?k]gPO'X0p:s?cۤN16`#?b/YrHLx:}LT*f#DU5`W+yt~*# >o_Rf;ٺ/OsOn0ykAQ&q^ݩIp~Vgda5&ۍן֯F2{JCp4n?砩&*;Z@K quB(@fiq*;)}~}*G–UP8ǯa37>BFlc9*2_k SR'Oiؓ2S qcrM+v<J Z$)RB|Wӣ~#EmF Xpry[ŶJ.E. <1RAxh[cCKZk֞aV9!O?6GGVio$`p8-ǚUbkM3[_*}xO]ZF2JĎFO\Wҗ71d O؊^-EAM#Bt/\fYݛ]@8he[[-$R@~|޽>|zb]ǕbUOrV:f$BDwRNG\d gqUlnm5/ෙ/1aH ܫ"Mw6:(d.lIČ9P]#TU<ӿcOl.MkT"Kl3g d9ӧk.8\1;OΣbK[h;@V^:uιonh$f;YׯnGqKю+ML.U  ~^^ 9ԩdĎCYk+4{HFj,sPiam$M!a L4Z3JR8(#P8QׁWe80֎Tq۷ھaCW^3K݋IY&xdgQ_L#5oւ S]=F|֨;qHO$jC 7QQ2I8;Оi5lv N;y5 PWqm@8'=qKu$=4FW sՉ9X" z5%LN>E8 hxCCkmϱFXB1/b=)wosr[#dc$R `~qAc}gW6,MZXb"84ӂ^֓?I8+.4}w^&*<\_|%okgۣ:nGe}s$(M6#xV&:QJmǢ>~5kp;' WnA#tVS{VIm;ARg >|xqZ^XFG ` VetauP~n=L^PX/#=x d.xIZzŦZN;{}jvE;tFB8A)gmw#j%m*ħʃ~:T22hr#>ޕv ;ag9͹>2B'yWn%ߎ_Dm6dB!k7MF5}Wt[ٺ6`N17]`9ӯZH0jIoTQsН $J Q՛>^U!BO|~UmgJ/ضRolv5'd/3#yX(r3*qdgNSvq֤ǠPFqje܏hF:is'>W+c=)PqhW\P6Ҧ#¢H-!/,*i5N &I N!,o{zc\M@<+8w782FRjnKS$9_=n_w|?tnuk5{iGn) 0qһN-2=.28hN$/$sɤIZoDedm1nb yڠF y|ysZ?e~XJӖMR%#Rg dzed}Jz}=koZiJ .Fn rJHZ\;OS9e,;E,bs_ƩӌW&؂Qg4$+ҵ4c-ppNFVwi̶R+p8r$3/\*ilhs,Wڛ;d%Wze1 p c<O=OֹO -N 'o8xs%mmWZxHVʼn,3`{3-$Rʶx:gˋY"V5+EiMJRCKY@[mm# n{.NDXrvM-ĥ|ib -TwyQYoφ ;]0O/) +25봰8PVRU,9ԵHgPGT!ŶlG Ec7{ԖkAb-3n!\F̄8UFvCq[m.VweUH 7HͅF8A!GK_חNbk&R$SE%<<սW4)5]{Lm185yVCȢB2@l}Jc+uhcv:MNYfZeR~e`7R2\BҢe<Z/7V68, 9ϰ%.a=w7ZPeydI`h u~+Q(-ԧc@;'$$1xF{c/؍͸gyr z{Y%q$Hk99=Zʇal)?LWql{U 3GA2޴Q&q_A?@u@!eX>sI'C9LWkrB1Pá }p~|,Ž>6?*rI57t|AҼUk %Y5'`1 nOӮur1Hcb2>`>^+ξCq|7ԭh-ີffWw ARsYI\BO,"1vCp׎Ni&-dӟ|u$ak#3 zټ;"yq,bW#<{a5ӦR5 0۽O弰)o2; V>:UGP𶝪iWʶZD/JcG^c$7vWH W'|ydtse*bB?Up]4F[1''';D,T1if$pB`ǯormq4Z#$vϯzĺm$|EXX$g*=O>G|">i:֭dͿqkkڤI N:I੼eiK%,L#7c(D#)tIN= 4k,$ ډ50~ ,HA8s%b>ϻ$NJ,+i4@!d"A9KjȽHj :+2ܡv 7n\m\zc}W?=E [}(I%%?sz5G<0e)vft HO Rx~3ix>'ww71j,Q]mcrT$hG,q+,ike?eVN8Wpӭ|=UWU`kHS;`+zi5}$wCim7bwc>KJ_kM[D|_Nxm$Ueabij8+c_s2aGJXcGT4md?N{EC0A f@1ۀ“]ƹmU^iMwm`.熙򫝣o<(wy[m"I4?#tRV>wIJv4(/<D30T]̷S3m2[ePFWX)붻ox_#uKIm!Y.|#;<1@9G5o-mskr5f2;"X>e q[{H T=Yڙ!m\Q?62G{߼7^qG{u8,ḀdGCoAp}zm$cՅݲ)$(s9G5c{/$7$NL22;dA9nFSB0$z:o+6YVCmG> 7`ao2$#pحeZ' en)1#%n89me*P##ڻ;0ͪg4w@K`8sTt DθUp0F}k(rvO |o>$F. .*A,& ^R'EnPف, lpjk}KR,7. W3K${(! a|9K`pivTd0~e d|,sCq]:ox`$n^2d5ғz_ VW=OZVM<1!g?Jx6;t)w+ !A +oC/KvJ R:V霎蚾`qw#[vqs`KP< +B; -Fyex"wCv`0*8j5#b:'eG n$qhZK;l.,g[0 9+W-5^ /^1]β9*Cc+$΍7fe=S0> hzkxHEWI9%I`NxwzV~WV\}\F˝0 gam RLO@)*xu5}:nrnDR'n#PzuYsiJ~?cͨ6G|Qpo ?HRɄSШ*Ϡ cCƗ72;58R?}`7 bj~Cok R*]|zc%*ϗ^deJpzcN41n5/=쯘D-=aq}=[[k%GɾHzNzz-7K4vbH6qӡ5mr"yPCxéwdsIɵތ., "E7sT+{x|i*A4:'&1ӊɃqX"EmpzvHFɊM^y #[r3 m s*E-KH[-m]çKWR]{5X6ch󄬊`dc=~kvF70C4C/"1H'5$m+Q߈>x5b+Ś` 72)!=?T+hG9Sۧ_jPW7D2 2Eew,Ӓ:㞽XX1g'" #s0cMyYB)v$m=9?O%֗Lޡg`AqĎ3&3 H#](izW:05}|c'W4C^Nf:x bD< eƗgd  rr=ø&{o 䳑9^ÖԖ{i($\>ÀGq#Ҿ,E↩ioeeZZ\"1)d9l `Tp0qƏ6rݻE۬1¶[E wSے}I#-Ӵ_Y xmd $5V=k.4;X Z)VHK}q#(?2?[7lΡ%bWN#O,KKѮLi〨w6B~nwC'!V ]O;,tӨ+Ao8a3>2Y jj7BK=aE<]|ޢG)Oy. [ԏtx80{թƨmYr6З#͵}.zeMCZy7FϦΓ?ʡ-6#ϫiV~ ai^3ʈMȅP:sYjs,[C92sds#e8's?@m%!J<9;gk0x ϊ T2̫}%DRz'M6E4 F6W01-ڱMFHգ烢{.D<)aTbI5j<ٙ3MNxMψZ}ׇEA+G="'bl aϩx::1xKmDemn 20>Y0j9⤕b/>jem'["bR]<Nqpj$Q1XQFAAzw j0}iZ m*BbrNxA"St鈭fWsvӨc#J5^Heet`Uԕ =뷰|C?ZO5Y#piL:7qdtXtOs3~:9wH<{Z61ק?V݄1Q`cUذzG]deO[}{9 f!l#R TYqIbk9MvXE`Tq>o]|8N}6ۢG+2Z-IP s5[xd܌5>ʁ4I$y=_UwյX-n>ʆ)v,[dr99ޭVSDeh>z>p;G%'hKvV𵽾X6/ N?%FElrǫ71=Gl׷Ju Y/QI"TNNo]6W|AMŦ{8.lB e{9*콺[dmo\ݏr}ZT\= 8fV&Vq!2A*A=k<5[Q9#ʄ8b<0xc3{,> mw>7679'*怗WW2%ypI,w'8$ tu)+*ݑEO ͏Zrx cS/\AE7H VEpN[cR5?wPY{U–lcvX#qtn\G v>Xǂ9ő̀횧cktʬ Z$EPnc~U{(ng)q,+ɴAb=px53^Ju@ً{HFcy'I&B( {}sO Jvsq_q=dKqCF}8_  ̵ rX XtՁdTd_|ca|}}eRI<% 4sP0!sNIBjz妨zmޙskicdF9Gmo>TxCK?-'_26@WFL#t>54 i4wі+[YtUgRwcx uU&[;xْDr2:u=2IItgFYjT[DȱRI8F\焷kYv哅8uWms^Oil^ EiZ5 ̧r3#-/;٧VrpdexqnԊ10U0cpd8NFM=iec}GOD'zr`tL1shl;-m"+3l`JsBl4LZA*bFBpÁЌ94㵅Nwњ>j0gF8̑wp{uDuyEىT7?$d.IRWnmŠXQd$9=qӱ5jq< $P9 ߱߷n+t1X4;WNi$l3}m;]~˩$gzɘ6K$c1+%pq `j-,AQYy$g'#8'-k/Ka&Y6`ly ~`yvfwV-ݞ޴0f v! $\q\\Ɨ7Bdhd.$!Qr#ޛyj׹ه|0?LkYNY&S *#bpQ#WNsym+"p!, PdЂ@Sr+𕨛dȀ>Ecm09,a:w nb#rGSg1o3⟅ٛqmjМjTwJ}ܨ9fP1~զٲ7 YnN$r8w#uZfM[ՊfY7Fqh c #ҫ[N,ycmxǠ %bR;岲[˗DdT8_vzqXi`{hspve^A!<NiW~<F1ը Q(V0)! c+xR9'&w_J8V>$Q'~nNzESӚ˭>]vW34nTC=GqwTVw0"7g$;s}s,$7 vqq:h,vS5>T`!iq#][#28;u+.?rڔ.9fLm^ 1I#$hb9 [k0?ֵ/iwk#,ryY</(@$qr^1~F _q+--eRFʲļ=F<9Kgrm+,1BqۜꮄzQtgd.F {+.k~5呭%{8(#r]ZsHd _~!a/i8]L'\S_hkq5Dx-V$1' d,yu[KHakV #Do'8?tT^&Wu4[Ͽ[TˤEl*Ƚw 'JNl۹bĞ&Q(L% Js!Hd07sMXI#MRmBRg(>Pw'aqEoX#z4#IY|cǩκhkmČZ60YnM$}|ut~OOipO ˪>Ҡ*u'?,IZx uZNiTB4lsdhahuKi- + r Hp*Fzg4 j:O왮Kp12A`A\Zq}WeO!֢a=:+;뛋k{hf LdgZHntFnf[B7!Fn dGQa.jZ}[FHUWpČt'P\ q]ʋ!Uyv'$q]7mnRh. %ƭDֺVdg%mqXg HHlݙ9Ik=ݟ+%ZZтIj*rr|ц`q-ȶ>u/!9\ץtQSIC<] *w3@T{ qiZ@?x1'p=2e>;8<ѷjrK4G 8#qf JVg#=Ǧz f,KO^'?6x0;Eƙ,HH9?Hl6vVpưۦ$ =I\k1yQXZ10,HK~5\P[O.1Gfhe!p?NLna-X׶i{ -uoa*:Wiï9<Ƒny ~̚ v]Nɮ浕m+dJʸ-gOV=zJmn6JHُz2дm#KfoZSG,: yyC#8CS݃ 313pqIb9Z}ƥᘬ"n!h,FpK\;g<#=:_E$tWv@TzΚqgmgpG9$W=ln;с'3k i&X 0e+8'OJдG;+\bPR1zUXٴw!ӻI1tN.KM.vifB@p\pI*?ruV.l7(C$+&%X\ ~au5l [8#קu5ԑd%`<#%1s%+v<~~ͪnu+1K9Ƿ5ց>x 9a6p[;Asx'|\iN̉#eXz{)Mj"&zέ-sLW}Yb* g'5βCNzu=jnԍƝ Vvy*l;0 '=xc=" oi7M9eUdnwgw@ѯ5أӧd\diQFt.oa>璑]Ȅ2m(smb@;qrjƝkY[D8 vۖ>,~DmY9{w%&4R Nߑ p1#LRMFa1[K(b@ m KoeqmEFڿ)_0O^烌jXحxyk }K|z\UR8X!Kyu,Bۧ0q4_- x IH:_H![M P| T9#ç"à*K,0emq$s4_:v='t[+kRisJd!vw=NIsMN~Ѵii D 7 9&ET&[TAtZ̖Wos(3A&PQT9W,I՚)V[rl]Č{w!+٣dц:cڭn wt:dSe1,AczsW,bAxw#mN:ZcvPI#n09ٞ|d*r=:ݿtF l YD&6r"6@STuOuw2uUm> A-26ϕLg `O\)㎦HFm14Sp# W\q}8[x:ͯ&gC,w3c{rX lEuφzVsxL AqͿN9񓐤pFsS<-NUSRº mJ B̮ZX}jV*4@ ]B팱Q1}+[<1| ^wd,nrjWtm'*|IN^-MtgXbA Y`&_#D0 (R۰ l'# k:QC%E R]q ?7\Zx5[GCNPI\"nP9i8rkF^K-u 25=9F22x$kҫ(/(.4wT6 Xn,1H߽W 嬑G,-y'uJ)Fn-qscK,KC}i;=v<~fn~%4CڦQ ' 9k5̟7]H8(~ 1l Oґp{zWBC<&fm.@\\27omWZ/$O:fQO^=qY?-ŌHE3$BqT dڿ)셼S<(rK[i=7zb&ikykk16 D&Dळ2덠tRr֞쌴e}q߭h u(6Tp(@F \sPdz;A3\++Ps=dz qzCWX}< 2zmwQ#p:gVdKU@IbkJf23y#Vela隒NddwÒ3AqWD#'}?P E:ͧ8?NaR[U, |*]h-/6V&xRpa)Q$[Gsm*ᢒ0^QxBǡFig{V׻T[_y Emo0wxA0!2A=GzkI<^چ7QrdM|~hs_i#9 ֩+)M6դVT*^@##֛6)qJ?ӯn vI*Yir[)(W$dz63"a6~HNI`;|s#Cl&('rp[@kKfUlx'1S$r6 JiW5Ȧ4 \ ~<,qNG@JO@mQzͿsӡ=To jz}I튭'eD#ʂ2}~j~:iu fZ7t>ֿYݒBt)$:O.f1=Ĭz;/BZk]O@-O&HȌYFFqp=U c-]SۯY$ݟǰO~_*fR~C~(qW:FK;\'Q}H:MƻFuq(  'I(:5q_șy/Y^$8N\(,mѡ24PYIF gv=:3}[z$m-"qO0 mq1\o:/}^fiƓk+c}ͦjxZMQn0\^~V+BhȱB8-.oL=v .Ziv,JF9cZ^ p8?Zɍŝ1Lh#A01϶9v:ٲ<q[p@r;F1NvZz\jl]2aJgIHlxbNw]\zj{e쑤H{6K,q4kGXbXĎC߰{t\|9F={}j7X01Y:?jXzh4|[G+-}Qw)ag ^}{}mh(Ttc9 1Ox{U}sˉ<Ѵ m`c+֬(㼒i }]LdUG noԩ/yԴ"OM)ҤXN(` r|aw`8{W;bS8-"98&|]ʣTtӔ}wA͇, s;>awG)l*$,x 7rA<`-iWQ]9xi9S~N}ztՓ*\;L ˒k/' Nt(sR95ݝܰ_4bdx V0_'#8Ҥh.v QA%pt|^E;:EqʓqTUo6iݎ#֣;:[H^v 1au0#XPΜ zzOB+Ӵ$k66WgH-b.1=>^N+j{Ft+[7T.0KeTN9c;n}_luV#xaYgjܷrwe]x*s{~meZtv #?"m*$Ǩt\Qq1؏w$Op"V *H'ד\6xɚKUK)Ydp;H۹Rvv"B (Ibs׮I;Qrxo>8ٿcFu-! N gvrtE-Izza}:P)v%!f`r*r@AGWJYIZ,PHPn~bx!zy%3,Fe=Ft*YŸu3+dA! &1$j·~Ggbqi~ڻـ@g-=d88uףּe gk9QӱȩRٌq8?ts\6itΒ]4y? ԃJ2K4; qWr Kx]GM_3Nc%ع$)ʫ_G ZxMBgۏcJ0᱓JtؙoROVn30 +W<*Rìg0-Xׇ DH7tt$z_3tMaA{v3rJ n:WX>k-,{G nq3޸O&BxhDFR9I[ԼkuqflID {0 :%pAכ;nm&Wv~լ⹖h!m rzn|+[MFYmvfHRuA' צr@K]|FO'#/ v7d6\r@o$%I1w5mw IJDlI s&8)!Ӂ ߻=xsҷ@4nsdڅ$ߜ)'9aI^lm?? E%]TCdqj`:ϲy[Q,X }kR-cMRag'ff·@=~S=z(HhTd\+m9_FWIs^i6WTQYaz Mݏ$I fH-ĺU F8Yy`֔8Y&q֚kEM07gJ4mx<֥4^O3RS|lPv8pxWiӬm )]XI==ۯث<=%Y(V4ᰃh 9=HNrӭ Kg#ryٍ䟗x9Fy9 :AkV/۪C-+1|=Vo{X:+EI l 瞔etNkKh: &KbVW09#5r%ղM=Hd4 g>n@ᶺP]լqiopQ1B9;:r ~۴'zi QČrqہ~ټJORZ;̣jV9lXgpgPOGPi% 1I`SzEB\q8)+_Xwk$&<<>?\IZB ܊ʯ`I{b3_jYe)?6?1s;X5M99%4&Bqr?SU`J3*7 jBPy""kd* 1>4 ,=Fbu F?JB+o+ PAv,FO%m${o=G鏽VTpS8=><֚54 xH:ev O~]G*AhdQi=B@kw)cZ$72?ʈXn $999L_oy",q4r Q匱nǯN0HnaԢ4?iB2wwɯ9Ms-{/Ͽ;mE~x_V4sXԴ-lb (Qϔo9޲4 GczPDJB"X㐻lVH2CG'ۅ8랜9veyd@ڤUb`PHOQR!#q~7b@ <~Ұg+=srT:Tۉb] AQF7r'xwmb`sۼH$eFGz֋K29%R4p3ԒϯAU(a\YprH"Ċإv0I68њ &!@Wy-vo.G?T;)&cI<9`(õ*jqV;>zي)ã6UpO'9^?cs,kt0ff/89Cһ?j^nWvcs|Ff_ ԱTP}y/ԯفAudio-FLAC-Header-2.4/data/md5.flac0000644000076500007650000001271511150671243016030 0ustar danieldanielfLaC"- BB'uOuR\ 7 =` թ *!6?(A m/Ln6PYz= g(vCr%aJyWQ6*X`Ȅ_ el}sđzP rɾԇ2W` "5q* a.P-  8Gy~ҰRـ\oPdm[vp2:yP &lF$Pn +v1A[8B? FPM }S !Zha MghP*{xo4u?|K pW*PcL pc~aay reference libFLAC 1.1.4 20070213 TITLE=IV. Allegro impetuoso ARTIST=Henry Charles Litolff*ALBUM=The Romantic Piano Concerto, vol. 14TRACKNUMBER=08GENRE=Classical DATE=1996?COMMENT=Exact Audio Copy 0.95 b3 Secure Mode / FLAC q8 v. 1.1.2PERFORMER1=Peter Donohoe, piano)PERFORMER2=Bournemouth Symphony OrchestraPERFORMER3=Andrew Litton3OPUS=Concerto Symphonique no. 4 in D minor, op. 102 OPUSTRACK=4~Audio-FLAC-Header-2.4/Header.xs0000644000076500007650000005007711243275644015362 0ustar danieldaniel/* $Id: Header.xs 360 2005-11-26 08:02:13Z dsully $ */ /* This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * Chunks of this code have been borrowed and influenced from the FLAC source. * */ #ifdef __cplusplus "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif #include /* for PRIu64 */ #include #define FLACHEADERFLAG "fLaC" #define ID3HEADERFLAG "ID3" #ifdef _MSC_VER # define stat _stat #endif /* strlen the length automatically */ #define my_hv_store(a,b,c) (void)hv_store(a,b,strlen(b),c,0) #define my_hv_store_ent(a,b,c) (void)hv_store_ent(a,b,c,0) #define my_hv_fetch(a,b) hv_fetch(a,b,strlen(b),0) void _cuesheet_frame_to_msf(unsigned frame, unsigned *minutes, unsigned *seconds, unsigned *frames) { *frames = frame % 75; frame /= 75; *seconds = frame % 60; frame /= 60; *minutes = frame; } void _read_metadata(HV *self, char *path, FLAC__StreamMetadata *block, unsigned block_number) { unsigned i; int storePicture = 0; HV *pictureContainer = newHV(); AV *allpicturesContainer = NULL; switch (block->type) { case FLAC__METADATA_TYPE_STREAMINFO: { HV *info = newHV(); float totalSeconds; my_hv_store(info, "MINIMUMBLOCKSIZE", newSVuv(block->data.stream_info.min_blocksize)); my_hv_store(info, "MAXIMUMBLOCKSIZE", newSVuv(block->data.stream_info.max_blocksize)); my_hv_store(info, "MINIMUMFRAMESIZE", newSVuv(block->data.stream_info.min_framesize)); my_hv_store(info, "MAXIMUMFRAMESIZE", newSVuv(block->data.stream_info.max_framesize)); my_hv_store(info, "SAMPLERATE", newSVuv(block->data.stream_info.sample_rate)); my_hv_store(info, "NUMCHANNELS", newSVuv(block->data.stream_info.channels)); my_hv_store(info, "BITSPERSAMPLE", newSVuv(block->data.stream_info.bits_per_sample)); my_hv_store(info, "TOTALSAMPLES", newSVnv(block->data.stream_info.total_samples)); if (block->data.stream_info.md5sum != NULL) { /* Initialize an SV with the first element, and then append to it. If we don't do it this way, we get a "use of uninitialized element" in subroutine warning. */ SV *md5 = newSVpvf("%02x", (unsigned)block->data.stream_info.md5sum[0]); for (i = 1; i < 16; i++) { sv_catpvf(md5, "%02x", (unsigned)block->data.stream_info.md5sum[i]); } my_hv_store(info, "MD5CHECKSUM", md5); } my_hv_store(self, "info", newRV_noinc((SV*) info)); /* Store some other metadata for backwards compatability with the original Audio::FLAC */ /* needs to be higher resolution */ totalSeconds = block->data.stream_info.total_samples / (float)block->data.stream_info.sample_rate; if (totalSeconds <= 0) { warn("File: %s - %s\n%s\n", path, "totalSeconds is 0 - we couldn't find either TOTALSAMPLES or SAMPLERATE!", "setting totalSeconds to 1 to avoid divide by zero error!" ); totalSeconds = 1; } my_hv_store(self, "trackTotalLengthSeconds", newSVnv(totalSeconds)); my_hv_store(self, "trackLengthMinutes", newSVnv((int)totalSeconds / 60)); my_hv_store(self, "trackLengthSeconds", newSVnv((int)totalSeconds % 60)); my_hv_store(self, "trackLengthFrames", newSVnv((totalSeconds - (int)totalSeconds) * 75)); break; } case FLAC__METADATA_TYPE_PADDING: case FLAC__METADATA_TYPE_SEEKTABLE: /* Don't handle these yet. */ break; case FLAC__METADATA_TYPE_APPLICATION: { if (block->data.application.id[0]) { HV *app = newHV(); SV *tmpId = newSVpvf("%02x", (unsigned)block->data.application.id[0]); SV *appId; for (i = 1; i < 4; i++) { sv_catpvf(tmpId, "%02x", (unsigned)block->data.application.id[i]); } /* Be compatible with the pure perl version */ appId = newSVpvf("%ld", strtol(SvPV_nolen(tmpId), NULL, 16)); if (block->data.application.data != 0) { my_hv_store_ent(app, appId, newSVpvn((char*)block->data.application.data, block->length)); } my_hv_store(self, "application", newRV_noinc((SV*) app)); SvREFCNT_dec(tmpId); SvREFCNT_dec(appId); } break; } case FLAC__METADATA_TYPE_VORBIS_COMMENT: { AV *rawTagArray = newAV(); HV *tags = newHV(); SV **tag = NULL; SV **separator = NULL; if (block->data.vorbis_comment.vendor_string.entry) { my_hv_store(tags, "VENDOR", newSVpv((char*)block->data.vorbis_comment.vendor_string.entry, 0)); } for (i = 0; i < block->data.vorbis_comment.num_comments; i++) { if (!block->data.vorbis_comment.comments[i].entry || !block->data.vorbis_comment.comments[i].length) { warn("Empty comment, skipping...\n"); continue; } /* store the pointer location of the '=', poor man's split() */ char *entry = (char*)block->data.vorbis_comment.comments[i].entry; char *half = strchr(entry, '='); /* store the raw tags */ av_push(rawTagArray, newSVpv(entry, 0)); if (half == NULL) { warn("Comment \"%s\" missing \'=\', skipping...\n", entry); continue; } if (hv_exists(tags, entry, half - entry)) { /* fetch the existing entry */ tag = hv_fetch(tags, entry, half - entry, 0); /* fetch the multi-value separator or default and append to the entry */ if (hv_exists(self, "separator", 9)) { separator = hv_fetch(self, "separator", 9, 0); sv_catsv(*tag, *separator); } else { sv_catpv(*tag, "/"); } /* concatenate with the new entry */ sv_catpv(*tag, half + 1); } else { (void)hv_store(tags, entry, half - entry, newSVpv(half + 1, 0), 0); } } my_hv_store(self, "tags", newRV_noinc((SV*) tags)); my_hv_store(self, "rawTags", newRV_noinc((SV*) rawTagArray)); break; } case FLAC__METADATA_TYPE_CUESHEET: { AV *cueArray = newAV(); /* * buffer for decimal representations of uint64_t values * * newSVpvf() and sv_catpvf() can't handle 64-bit values * in some cases, so we need to do the conversion "manually" * with sprintf() and the PRIu64 format macro for portability * * see http://bugs.debian.org/462249 * * maximum string length: ceil(log10(2**64)) == 20 (+trailing \0) */ char decimal[21]; /* A lot of this comes from flac/src/share/grabbag/cuesheet.c */ const FLAC__StreamMetadata_CueSheet *cs; unsigned track_num, index_num; cs = &block->data.cue_sheet; if (*(cs->media_catalog_number)) { av_push(cueArray, newSVpvf("CATALOG %s\n", cs->media_catalog_number)); } av_push(cueArray, newSVpvf("FILE \"%s\" FLAC\n", path)); for (track_num = 0; track_num < cs->num_tracks-1; track_num++) { const FLAC__StreamMetadata_CueSheet_Track *track = cs->tracks + track_num; av_push(cueArray, newSVpvf(" TRACK %02u %s\n", (unsigned)track->number, track->type == 0? "AUDIO" : "DATA" )); if (track->pre_emphasis) { av_push(cueArray, newSVpv(" FLAGS PRE\n", 0)); } if (*(track->isrc)) { av_push(cueArray, newSVpvf(" ISRC %s\n", track->isrc)); } for (index_num = 0; index_num < track->num_indices; index_num++) { const FLAC__StreamMetadata_CueSheet_Index *index = track->indices + index_num; SV *indexSV = newSVpvf(" INDEX %02u ", (unsigned)index->number); if (cs->is_cd) { unsigned logical_frame = (unsigned)((track->offset + index->offset) / (44100 / 75)); unsigned m, s, f; _cuesheet_frame_to_msf(logical_frame, &m, &s, &f); sv_catpvf(indexSV, "%02u:%02u:%02u\n", m, s, f); } else { sprintf(decimal, "%"PRIu64, track->offset + index->offset); sv_catpvf(indexSV, "%s\n", decimal); } av_push(cueArray, indexSV); } } sprintf(decimal, "%"PRIu64, cs->lead_in); av_push(cueArray, newSVpvf("REM FLAC__lead-in %s\n", decimal)); sprintf(decimal, "%"PRIu64, cs->tracks[track_num].offset); av_push(cueArray, newSVpvf("REM FLAC__lead-out %u %s\n", (unsigned)cs->tracks[track_num].number, decimal) ); my_hv_store(self, "cuesheet", newRV_noinc((SV*) cueArray)); break; } /* The PICTURE metadata block came about in FLAC 1.1.3 */ #ifdef FLAC_API_VERSION_CURRENT case FLAC__METADATA_TYPE_PICTURE: { HV *picture = newHV(); SV *type; my_hv_store(picture, "mimeType", newSVpv(block->data.picture.mime_type, 0)); my_hv_store(picture, "description", newSVpv((const char*)block->data.picture.description, 0)); my_hv_store(picture, "width", newSViv(block->data.picture.width)); my_hv_store(picture, "height", newSViv(block->data.picture.height)); my_hv_store(picture, "depth", newSViv(block->data.picture.depth)); my_hv_store(picture, "colorIndex", newSViv(block->data.picture.colors)); my_hv_store(picture, "imageData", newSVpv((const char*)block->data.picture.data, block->data.picture.data_length)); my_hv_store(picture, "pictureType", newSViv(block->data.picture.type)); type = newSViv(block->data.picture.type); my_hv_store_ent(pictureContainer, type, newRV_noinc((SV*) picture)); SvREFCNT_dec(type); storePicture = 1; /* update allpictures */ if (hv_exists(self, "allpictures", 11)) { allpicturesContainer = (AV *) SvRV(*my_hv_fetch(self, "allpictures")); } else { allpicturesContainer = newAV(); /* store the 'allpictures' array */ my_hv_store(self, "allpictures", newRV_noinc((SV*) allpicturesContainer)); } av_push(allpicturesContainer, (SV*) newRV((SV*) picture)); break; } #endif /* XXX- Just ignore for now */ default: break; } /* store the 'picture' hash */ if (storePicture && hv_scalar(pictureContainer)) { my_hv_store(self, "picture", newRV_noinc((SV*) pictureContainer)); } else { SvREFCNT_dec((SV*) pictureContainer); } } /* From src/metaflac/operations.c */ void print_error_with_chain_status(FLAC__Metadata_Chain *chain, const char *format, ...) { const FLAC__Metadata_ChainStatus status = FLAC__metadata_chain_status(chain); va_list args; FLAC__ASSERT(0 != format); va_start(args, format); (void) vfprintf(stderr, format, args); va_end(args); warn("status = \"%s\"\n", FLAC__Metadata_ChainStatusString[status]); if (status == FLAC__METADATA_CHAIN_STATUS_ERROR_OPENING_FILE) { warn("The FLAC file could not be opened. Most likely the file does not exist or is not readable."); } else if (status == FLAC__METADATA_CHAIN_STATUS_NOT_A_FLAC_FILE) { warn("The file does not appear to be a FLAC file."); } else if (status == FLAC__METADATA_CHAIN_STATUS_NOT_WRITABLE) { warn("The FLAC file does not have write permissions."); } else if (status == FLAC__METADATA_CHAIN_STATUS_BAD_METADATA) { warn("The metadata to be writted does not conform to the FLAC metadata specifications."); } else if (status == FLAC__METADATA_CHAIN_STATUS_READ_ERROR) { warn("There was an error while reading the FLAC file."); } else if (status == FLAC__METADATA_CHAIN_STATUS_WRITE_ERROR) { warn("There was an error while writing FLAC file; most probably the disk is full."); } else if (status == FLAC__METADATA_CHAIN_STATUS_UNLINK_ERROR) { warn("There was an error removing the temporary FLAC file."); } } MODULE = Audio::FLAC::Header PACKAGE = Audio::FLAC::Header PROTOTYPES: DISABLE SV* _new_XS(class, path) char *class; char *path; CODE: HV *self = newHV(); SV *obj_ref = newRV_noinc((SV*) self); /* Start to walk the metadata list */ FLAC__Metadata_Chain *chain = FLAC__metadata_chain_new(); if (chain == 0) { die("Out of memory allocating chain"); XSRETURN_UNDEF; } if (!FLAC__metadata_chain_read(chain, path)) { print_error_with_chain_status(chain, "%s: ERROR: reading metadata", path); XSRETURN_UNDEF; } { FLAC__Metadata_Iterator *iterator = FLAC__metadata_iterator_new(); FLAC__StreamMetadata *block = 0; FLAC__bool ok = true; unsigned block_number = 0; if (iterator == 0) { die("out of memory allocating iterator"); } FLAC__metadata_iterator_init(iterator, chain); do { block = FLAC__metadata_iterator_get_block(iterator); ok &= (0 != block); if (!ok) { warn("%s: ERROR: couldn't get block from chain", path); } else { _read_metadata(self, path, block, block_number); } block_number++; } while (ok && FLAC__metadata_iterator_next(iterator)); FLAC__metadata_iterator_delete(iterator); } FLAC__metadata_chain_delete(chain); /* Make sure tags is an empty HV if there were no VCs in the file */ if (!hv_exists(self, "tags", 4)) { my_hv_store(self, "tags", newRV_noinc((SV*) newHV())); } /* Find the offset of the start pos for audio blocks (ie: after metadata) */ { unsigned int is_last = 0; unsigned char buf[4]; long len; struct stat st; float totalSeconds; PerlIO *fh; if ((fh = PerlIO_open(path, "r")) == NULL) { warn("Couldn't open file [%s] for reading!\n", path); XSRETURN_UNDEF; } if (PerlIO_read(fh, &buf, 4) == -1) { warn("Couldn't read magic fLaC header!\n"); PerlIO_close(fh); XSRETURN_UNDEF; } if (memcmp(buf, ID3HEADERFLAG, 3) == 0) { unsigned id3size = 0; int c = 0; /* How big is the ID3 header? Skip the next two bytes */ if (PerlIO_read(fh, &buf, 2) == -1) { warn("Couldn't read ID3 header length!\n"); PerlIO_close(fh); XSRETURN_UNDEF; } /* The size of the ID3 tag is a 'synchsafe' 4-byte uint */ for (c = 0; c < 4; c++) { if (PerlIO_read(fh, &buf, 1) == -1 || buf[0] & 0x80) { warn("Couldn't read ID3 header length (syncsafe)!\n"); PerlIO_close(fh); XSRETURN_UNDEF; } id3size <<= 7; id3size |= (buf[0] & 0x7f); } if (PerlIO_seek(fh, id3size, SEEK_CUR) < 0) { warn("Couldn't seek past ID3 header!\n"); PerlIO_close(fh); XSRETURN_UNDEF; } if (PerlIO_read(fh, &buf, 4) == -1) { warn("Couldn't read magic fLaC header!\n"); PerlIO_close(fh); XSRETURN_UNDEF; } } if (memcmp(buf, FLACHEADERFLAG, 4)) { warn("Couldn't read magic fLaC header - got gibberish instead!\n"); PerlIO_close(fh); XSRETURN_UNDEF; } while (!is_last) { if (PerlIO_read(fh, &buf, 4) != 4) { warn("Couldn't read 4 bytes of the metadata block!\n"); PerlIO_close(fh); XSRETURN_UNDEF; } is_last = (unsigned int)(buf[0] & 0x80); len = (long)((buf[1] << 16) | (buf[2] << 8) | (buf[3])); PerlIO_seek(fh, len, SEEK_CUR); } len = PerlIO_tell(fh); PerlIO_close(fh); my_hv_store(self, "startAudioData", newSVnv(len)); /* Now calculate the bit rate and file size */ totalSeconds = (float)SvIV(*(my_hv_fetch(self, "trackTotalLengthSeconds"))); /* Find the file size */ if (stat(path, &st) == 0) { my_hv_store(self, "fileSize", newSViv(st.st_size)); } else { warn("Couldn't stat file: [%s], might be more problems ahead!", path); } my_hv_store(self, "bitRate", newSVnv(8.0 * (st.st_size - len) / totalSeconds)); } my_hv_store(self, "filename", newSVpv(path, 0)); /* Bless the hashref to create a class object */ sv_bless(obj_ref, gv_stashpv(class, FALSE)); RETVAL = obj_ref; OUTPUT: RETVAL SV* _write_XS(obj) SV* obj CODE: FLAC__bool ok = true; HE *he; HV *self = (HV *) SvRV(obj); HV *tags = (HV *) SvRV(*(my_hv_fetch(self, "tags"))); char *path = (char *) SvPV_nolen(*(my_hv_fetch(self, "filename"))); FLAC__Metadata_Chain *chain = FLAC__metadata_chain_new(); if (chain == 0) { die("Out of memory allocating chain"); XSRETURN_UNDEF; } if (!FLAC__metadata_chain_read(chain, path)) { print_error_with_chain_status(chain, "%s: ERROR: reading metadata", path); XSRETURN_UNDEF; } FLAC__Metadata_Iterator *iterator = FLAC__metadata_iterator_new(); FLAC__StreamMetadata *block = 0; FLAC__bool found_vc_block = false; if (iterator == 0) { die("out of memory allocating iterator"); } FLAC__metadata_iterator_init(iterator, chain); do { block = FLAC__metadata_iterator_get_block(iterator); if (block->type == FLAC__METADATA_TYPE_VORBIS_COMMENT) { found_vc_block = true; } } while (!found_vc_block && FLAC__metadata_iterator_next(iterator)); if (found_vc_block) { /* Empty out the existing block */ if (0 != block->data.vorbis_comment.comments) { FLAC__ASSERT(block->data.vorbis_comment.num_comments > 0); if (!FLAC__metadata_object_vorbiscomment_resize_comments(block, 0)) { die("%s: ERROR: memory allocation failure\n", path); } } else { FLAC__ASSERT(block->data.vorbis_comment.num_comments == 0); } } else { /* create a new block if necessary */ block = FLAC__metadata_object_new(FLAC__METADATA_TYPE_VORBIS_COMMENT); if (0 == block) { die("out of memory allocating VORBIS_COMMENT block"); } while (FLAC__metadata_iterator_next(iterator)); if (!FLAC__metadata_iterator_insert_block_after(iterator, block)) { print_error_with_chain_status(chain, "%s: ERROR: adding new VORBIS_COMMENT block to metadata", path); XSRETURN_UNDEF; } /* iterator is left pointing to new block */ FLAC__ASSERT(FLAC__metadata_iterator_get_block(iterator) == block); } FLAC__StreamMetadata_VorbisComment_Entry entry = { 0 }; FLAC__metadata_object_vorbiscomment_append_comment(block, entry, /*copy=*/true); if (hv_iterinit(tags)) { while ((he = hv_iternext(tags))) { FLAC__StreamMetadata_VorbisComment_Entry entry; char *key = HePV(he, PL_na); char *val = SvPV_nolen(HeVAL(he)); char *ent = form("%s=%s", key, val); if (ent == NULL) { warn("Couldn't create key/value pair!\n"); XSRETURN_UNDEF; } if (strEQ(key, "VENDOR")) { entry.entry = (FLAC__byte *)val; } else { entry.entry = (FLAC__byte *)ent; } entry.length = strlen((const char *)entry.entry); if (strEQ(key, "VENDOR")) { if (!FLAC__metadata_object_vorbiscomment_set_vendor_string(block, entry, /*copy=*/true)) { warn("%s: ERROR: memory allocation failure\n", path); XSRETURN_UNDEF; } } else { if (!FLAC__format_vorbiscomment_entry_is_legal(entry.entry, entry.length)) { warn("%s: ERROR: tag value for '%s' is not valid UTF-8\n", path, ent); XSRETURN_UNDEF; } if (!FLAC__metadata_object_vorbiscomment_append_comment(block, entry, /*copy=*/true)) { warn("%s: ERROR: memory allocation failure\n", path); XSRETURN_UNDEF; } } } } FLAC__metadata_iterator_delete(iterator); FLAC__metadata_chain_sort_padding(chain); ok = FLAC__metadata_chain_write(chain, /* padding */true, /*modtime*/ false); if (!ok) { print_error_with_chain_status(chain, "%s: ERROR: writing FLAC file", path); RETVAL = &PL_sv_no; } else { RETVAL = &PL_sv_yes; } FLAC__metadata_chain_delete(chain); OUTPUT: RETVAL Audio-FLAC-Header-2.4/META.yml0000644000076500007650000000055511171777230015061 0ustar danieldaniel--- abstract: interface to FLAC header metadata. author: Dan Sully, distribution_type: module generated_by: Module::Install version 0.67 license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: Audio-FLAC-Header no_index: directory: - inc - t requires: perl: 5.005 version: 2.4 Audio-FLAC-Header-2.4/Makefile.PL0000644000076500007650000000326511171776604015567 0ustar danieldaniel# Code to select XS or Pure Perl version inspired by Scalar::List::Utils use strict; use warnings; use Config; use inc::Module::Install; # Automatically select XS or PP version in case neither argument is given my $got_libFLAC = defined(search_lib('-lFLAC')); my $do_xs = can_cc() && $got_libFLAC; # Select XS or PP version if argument is given for (@ARGV) { /^-pp/ and $do_xs = 0; /^-xs/ and $do_xs = 1; } if ($do_xs && !$got_libFLAC) { warn "* libFLAC is not installed or not in the default lib path. Cannot build XS version.\n"; die "* Try building pure perl version by using -pp argument.\n"; } name('Audio-FLAC-Header'); license('perl'); perl_version('5.005'); all_from('Header.pm'); requires_external_cc() if $do_xs; if ($do_xs) { requires_external_cc(); print "Building XS version.\n"; if ($^O =~ /win32/i) { cc_lib_links('FLAC_static'); } else { cc_lib_links('FLAC'); cc_optimize_flags('-Wall') if $Config::Config{'archname'} =~ /gnu/i; } } else { print "Not building XS version.\n"; makemaker_args ( XS => {}, C => [] ); } auto_install(); WriteAll(); sub search_lib { my ($lib) = @_; unless ($lib =~ /^-l/) { warn "search_lib: illegal arguments, \`$lib\'.\n"; return undef; } my $libbase = 'lib' . substr($lib, 2) . $Config{lib_ext}; my $libbase_so = 'lib' . substr($lib, 2) . "." . $Config{so}; for my $path (split(' ', $Config{libpth})) { if (-f $path . '/' . $libbase) { print "$path/$libbase\n"; print "Found '$path/$libbase'.\n"; return $lib; } elsif (-f $path . '/' . $libbase_so) { print "$path/$libbase_so\n"; print "Found `$_/$libbase_so'.\n"; return $lib; } } return undef; } Audio-FLAC-Header-2.4/README0000644000076500007650000000257511243275722014473 0ustar danieldanielAudio::FLAC version 2.4 ======================= The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install If you have a C compiler & libFLAC installed, the library will build and use a XS version, which is much faster than the pure perl one. COPYRIGHT AND LICENCE Pure perl code Copyright (c) 2003-2004, Erik Reckase. Pure perl code Copyright (c) 2003-2007, Dan Sully & Slim Devices. Pure perl code Copyright (c) 2008-2009, Dan Sully XS code Copyright (c) 2004-2007, Dan Sully & Slim Devices. XS code Copyright (c) 2008-2009, Dan Sully This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.2 or, at your option, any later version of Perl 5 you may have available.