Audio-Moosic-0.10/0000711000175000017500000000000010744121423012342 5ustar raflraflAudio-Moosic-0.10/inc/0000711000175000017500000000000010744121423013113 5ustar raflraflAudio-Moosic-0.10/inc/Module/0000711000175000017500000000000010744121423014340 5ustar raflraflAudio-Moosic-0.10/inc/Module/Install/0000711000175000017500000000000010744121423015746 5ustar raflraflAudio-Moosic-0.10/inc/Module/Install/Can.pm0000644000175000017500000000337410744121417017027 0ustar raflrafl#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.68'; $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}), '.') { 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 157 Audio-Moosic-0.10/inc/Module/Install/WriteAll.pm0000644000175000017500000000162410744121417020045 0ustar raflrafl#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } 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; if ( $0 =~ /Build.PL$/i ) { $self->Build->write; } else { $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-Moosic-0.10/inc/Module/Install/Makefile.pm0000644000175000017500000001351110744121417020035 0ustar raflrafl#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.68'; $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, @_ ) if @_; $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"; } require File::Find; %test_dir = (); 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 @_; my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); $args->{VERSION} = $self->version || $self->determine_VERSION($args); $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->build_requires, $self->requires) ); # 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)) { $args{dist} = $preop; } 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 363 Audio-Moosic-0.10/inc/Module/Install/Metadata.pm0000644000175000017500000002152710744121417020046 0ustar raflrafl#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests installdirs }; my @tuple_keys = qw{ build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_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 (@tuple_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} unless @_; my @rv; while (@_) { my $module = shift or last; my $version = shift || 0; if ( $module eq 'perl' ) { $version =~ s{^(\d+)\.(\d+)\.(\d+)} {$1 + $2/1_000 + $3/1_000_000}e; $self->perl_version($version); next; } my $rv = [ $module, $version ]; push @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } # configure_requires is currently a null-op sub configure_requires { 1 } # 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, skipping\n"; return $self; } $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; return $self; } 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; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } 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', 0 ); require YAML; my $data = YAML::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 { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { my ( $self, $file ) = @_; local *FH; open FH, "< $file" or die "Cannot open $file.pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $v = $1; $v =~ s{_}{}g; $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); 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 $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ 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 public license' => 'gpl', 1, 'GNU lesser public license' => 'gpl', 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 ) { warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it."; } $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; Audio-Moosic-0.10/inc/Module/Install/Base.pm0000644000175000017500000000203510744121417017171 0ustar raflrafl#line 1 package Module::Install::Base; $VERSION = '0.68'; # 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; } 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 138 Audio-Moosic-0.10/inc/Module/Install/Fetch.pm0000644000175000017500000000463010744121417017353 0ustar raflrafl#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $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-Moosic-0.10/inc/Module/Install/Win32.pm0000644000175000017500000000341610744121417017225 0ustar raflrafl#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # 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, ); if (!$rv) { die <<'END_MESSAGE'; ------------------------------------------------------------------------------- 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-Moosic-0.10/inc/Module/Install.pm0000644000175000017500000001761110744121416016324 0ustar raflrafl#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 # } use 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.68'; } # 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 } use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; 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"; unshift @_, ($self, $1); goto &{$self->can('call')} unless uc($1) eq $1; }; } 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"}; } sub preload { my ($self) = @_; 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"; 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) ) { open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; my $in_pod = 0; while ( ) { $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; } } close PKGFILE; } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } 1; Audio-Moosic-0.10/MANIFEST.SKIP0000644000175000017500000000006310744120641014250 0ustar raflraflblib\b ^Makefile(?!\.PL) \.bak$ ^\. ^Audio-Moosic- Audio-Moosic-0.10/Changes0000644000175000017500000000221310744121065013645 0ustar raflraflRevision history for Perl extension Audio::Moosic. 0.10 Fri Jan 18 13:50:16 2008 - Minor update. No functional changes. 0.09 Mon Mar 21 20:45:33 2005 - Makefile.PL: Added RPC::XML to PREREQ_PM. 0.08 Wed Dez 15 15:10:03 2004 - Documentation fix. - Fixed fatal bugs in move() and move_list(). - Removed 'use 5.008004;' from Makefile.PL. 0.07 Tue Sep 14 21:23:08 2004 - Added can_play(). 0.06 Mon Sep 13 12:48:22 2004 - Fixed bug with set_loop_mode(). - Added play(). 0.05 Fri Aug 20 12:41:03 2004 - Don't croak anymore if the connect failed. Simply set $@ and return an undefined value. 0.04 Thu Aug 19 13:26:12 2004 - Added swap method introduced by moosic 1.5.1 (api version 1.8). 0.03 Thu Jul 15 09:35:34 2004 - LWP::Protocol::http::SocketUnix is the new name included in the module list. 0.02 Thu Jul 15 04:18:20 2004 - LWP::Protocol::http::UNIX is now known as LWP::Protocol::http::UnixSocket 0.01 Sun Jun 6 19:21:53 2004 - original version; created by h2xs 1.23 with options -AXO -n Audio::Moosic Audio-Moosic-0.10/t/0000711000175000017500000000000010744121423012605 5ustar raflraflAudio-Moosic-0.10/t/pod_coverage.t0000644000175000017500000000023210744117261015441 0ustar raflrafluse strict; use warnings; use Test::More; eval 'use Test::Pod::Coverage'; plan skip_all => 'Test::Pod::Coverage required' if $@; all_pod_coverage_ok(); Audio-Moosic-0.10/t/use.t0000644000175000017500000000013610744116656013612 0ustar raflrafluse strict; use warnings; use Test::More tests => 1; BEGIN { use_ok('Audio::Moosic'); } Audio-Moosic-0.10/t/pod.t0000644000175000017500000000020310744117137013566 0ustar raflrafluse strict; use warnings; use Test::More; eval 'use Test::Pod'; plan skip_all => 'Test::Pod required' if $@; all_pod_files_ok(); Audio-Moosic-0.10/Makefile.PL0000644000175000017500000000021310744117435014330 0ustar raflrafluse strict; use warnings; use inc::Module::Install; name 'Audio-Moosic'; all_from 'lib/Audio/Moosic.pm'; requires 'RPC::XML'; WriteAll; Audio-Moosic-0.10/META.yml0000644000175000017500000000055710744121417013635 0ustar raflrafl--- abstract: Moosic client library for Perl author: - Florian Ragwitz distribution_type: module generated_by: Module::Install version 0.68 license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: Audio-Moosic no_index: directory: - inc - t requires: RPC::XML: 0 version: 0.10 Audio-Moosic-0.10/MANIFEST0000644000175000017500000000054510744120644013513 0ustar raflraflChanges inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Audio/Moosic.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README t/pod.t t/pod_coverage.t t/use.t Audio-Moosic-0.10/lib/0000711000175000017500000000000010744121423013110 5ustar raflraflAudio-Moosic-0.10/lib/Audio/0000711000175000017500000000000010744121423014151 5ustar raflraflAudio-Moosic-0.10/lib/Audio/Moosic.pm0000644000175000017500000006356110744121361015764 0ustar raflraflpackage Audio::Moosic; use strict; use warnings; use vars qw( $VERSION ); use RPC::XML; use RPC::XML::Client; $VERSION = '0.10'; =head1 NAME Audio::Moosic - Moosic client library for Perl =head1 SYNOPSIS use Audio::Moosic; $moo = Audio::Moosic::Unix->new(); $moosic->append('/home/me/somewhat.ogg'); $moosic->play; print $moosic->current, "\n"; $moosic->pause; ... =head1 DESCRIPTION Audio::Moosic acts as a client for the musical jukebox programm Moosic (http://nanoo.org/~daniel/moosic/) by Daniel Pearson . Using Audio::Moosic you can connect to a moosic server either via an UNIX socket or an INET socket. =head1 METHODS =head2 new $moo = Audio::Moosic::Unix->new(); $moo = Audio::Moosic::Unix->new('/tmp/moosic/socket'); $moo = Audio::Moosic::Inet->new('localhost', 8765); Constructor. Initializes the class and invokes the connect method. If you're creating a Audio::Moosic::Unix object you can give the location of your moosic socket as parameter. If not ~/.moosic/socket is used. If you're creating a Audio::Moosic::Inet instance you need to pass host and port as arguments. You can't create an instance of Audio::Moosic itself. Use Unix or Inet subclass. If the object was able to connect to the moosic server a reference to the object instance is returned. If the connection failed $@ is set and undef returned. =cut sub new { my ($class, @args) = @_; $class = ref($class) || $class; my $self = { __errors => [ ] }; bless $self, $class; unless( $self->connect(@args) ) { $@ = "Can't connect to moosic server: $!"; return; } return $self; } =head2 connect $moo->connect('foobar.com', 9876); Connect to the moosic server. You normally don't need to run this method in your moosic client. =cut sub connect { require Carp; Carp::croak('This method should never be called. Please create an instance'. ' of Audio::Moosic::Inet or Audio::Moosic::Unix.'); } =head2 disconnect $moo->disconnect; Disconnect from the moosic daemon. No more calls will be sent to the server after calling this method. You'll need to reconnect() first. =cut sub disconnect { my $self = shift; $self->{__connected} = 0; delete $self->{__rpc_xml_client}; } =head2 reconnect $moo->reconnect; Disconnects from the server if you're connected and tries to reconnect. =cut sub reconnect { my $self = shift; $self->disconnect if $self->connected; return $self->connect; } =head2 connected $moo->reconnect unless $moo->connected; Check whether you're connected to the moosic server or not. =cut sub connected { my $self = shift; return $self->{__connected}; } =head2 client_config print $moo->client_config('location'); $conf = $moo->client_config(); Reads the moosic clients config. If a $key argument is given it returns only the value associated with that key, if not the whole config hash. Would it be a good idea to make the user able to edit the client_config here? Suggestions or maybe patches are welcome. =cut sub client_config { my ($self, $key) = @_; if($key) { return $self->{__client_config}{$key}; } else { return $self->{__client_config}; } } =head2 ping die unless $moo->ping; Checks if we're still connected. This method checks the connection explicitly by calling the no_op server method. connected() only checks the value of the 'connected' object property. =cut sub ping { my $self = shift; my $resp = $self->{__rpc_xml_client}->send_request('no_op'); if( ref $resp ) { $self->{__connected} = 1; } else { $self->{__connected} = 0; } return $self->connected; } =head2 error my $error = $moo->error; $moo->error('Whaaa!'); If an argument is given it adds the error string to the internal error array. If called in scalar context it returns the last error occured. If you call error() in list context the whole error array of the Audio::Moosic instance is returned. =cut sub error { my ($self, $error) = @_; if($error) { push(@{$self->{__errors}}, $error); } else { return wantarray ? @{$self->{__errors}} : @{$self->{__errors}}[@{$self->{__errors}} - 1]; } } =head2 call $moo->call('foo'); $moo->call('bar', RPC::XML::int->new(3)); This method calls a xml-rpc method on the moosic server. The first argument should be the method name. The arguments of that method should follow behind. If the request to the moosic server could not be sent the Audio::Moosic instance disconnects from the server and puts the error message into the internal error array. Access it via error(). The object won't send any calls anymore if such an error occured. You should try to reconnect. If the request could be sent, but returned an error the error message is added to the error array accessable via error(). If any error occured call() returns undef. If everything went fine the value of the response is returned. Normally you don't need to call this method. It is only used by other moosic methods to send their calls more easily. If a new moosic method is not supported by this library yet you'll maybe need to use call() manually. Please notice me if that happens so I'll add the new method. =cut sub call { my ($self, $method, @args) = @_; return unless $self->connected; my $resp = $self->{__rpc_xml_client}->send_request($method, @args); unless( ref $resp ) { my $error = qq/Lost connection to moosic server: "$resp"/; if( my $function = (caller(1))[3]) { $error .= " in $function()"; } $self->error($error); $self->{__connected} = 0; return; } if( $resp->is_fault ) { my $error = 'Error: '. $resp->code .': "'. $resp->string .'"'; if( my $function = (caller(1))[3]) { $error .= " in $function()"; } $self->error($error); return; } return $resp->value; } =head2 api_version @api = $moo->api_version; $api = $moo->api_version; Return the moosic servers API version. If called in scalar context a version string like '1.3' is returned. In list context the mayor and minor numbers of the API version are returned. =cut sub api_version { my $self = shift; my $resp = $self->call('api_version') or return; return wantarray ? @{$resp} : join('.', @{$resp}); } =head2 append $moo->append('/home/florian/whatever.ogg'); $moo->append('/home/florian/foo.ogg', '/home/florian/bar.mp3'); Add songs to the moosic queue. The files to add should be the arguments for the append method. append() returns 1 if there were no errors or something false if there were some. =cut sub append { my ($self, @items) = @_; return $self->call('append', RPC::XML::array->new( map { RPC::XML::base64->new($_) } @items )); } =head2 clear $moo->clear; Clears the moosic queue. Only the current song remains playing. =cut sub clear { my $self = shift; return $self->call('clear'); } =head2 crop $moo->crop(4); $moo->crop(3, 4); Remove all playlist items that don't fall within a given range. If the range is represented by one integer all items whose index is greater than or equal to the value will be removed. Two intergers represent all items whose index is greater than or equal to the value of first integer and less than the value of the second integer. =cut sub crop { my ($self, @range) = @_; return $self->call('crop', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range )); } =head2 crop_list $moo->crop_list(1, 4, 3); Remove all queued items exept those referenced by a list of positions. =cut sub crop_list { my ($self, @range) = @_; return $self->call('crop_list', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range )); } =head2 current print $moo->current; Return the name of the current playing song. =cut sub current { my $self = shift; return $self->call('current'); } =head2 current_time print $moo->current_time; Return the amount of time the current song has been playing. =cut sub current_time { my $self = shift; return $self->call('current_time'); } =head2 cut $moo->cut(3); $moo->cut(4, 10); Remove all queued items that fall within a given range. See crop() for details on how that range should look like. =cut sub cut { my ($self, @range) = @_; return $self->call('cut', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range )); } =head2 cut_list $moo->cut_list(3, 7, 9); Remove all queued items referenced by list of positions. =cut sub cut_list { my ($self, @range) = @_; return $self->call('cut_list', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range )); } =head2 die $moo->die; Tell the server to terminate itself. =cut sub die { my $self = shift; ($self->call('die') and $self->disconnect) or return; } =head2 filter $moo->filter('foo'); $moo->filter('bar', 4); $moo->filter('moo', 7, 11); Remove all items that don't match the given regular expression. You may limit this operation to a specific range which is described in crop(). =cut sub filter { my ($self, $regex, @range) = @_; return $self->call('filter', RPC::XML::base64->new($regex), RPC::XML::array->new( map { RPC::XML::int->new($_) } @range ) ); } =head2 get_history_limit $limit = $moo->get_history_limit; Get the limit on the size of the history list stored in servers memory. =cut sub get_history_limit { my $self = shift; return $self->call('get_history_limit'); } =head2 getconfig @config = $moo->getconfig; Return a list of the server's filetype-player associations. =cut sub getconfig { my ($self, $key) = @_; my $resp = $self->call('getconfig'); return @{$resp}; #TODO support $key to read single config options } =head2 halt_queue $moo->halt_queue; Stop any new songs from being played. Use run_queue() to reverse this state. =cut sub halt_queue { my $self = shift; return $self->call('halt_queue'); } =head2 haltqueue See halt_queue(). =cut sub haltqueue { my $self = shift; $self->halt_queue; } =head2 history %hist = $moo->history; Return a list of items that has been recently played. If a positive integer argument is given than no more than number of items will be returned. Otherwise the entire history is printed. history() returns an array of hashrefs like that: @history = ( { title => 'foo', start => 123.45, stop => 543.21 }, { title => 'bar', start => 234.56, stop => 654.32 }, ... ); =cut sub history { my ($self, $num) = @_; return map { title => $_->[0], start => $_->[1], stop => $_->[2] }, @{$self->call('history', RPC::XML::int->new( $num || 0 )) }; } =head2 indexed_list %list = $moo->indexed_list; %list = $moo->indexed_list(1); %list = $moo->indexed_list(2, 5); List the song queue's contents. If a range is specified, only the items that fall within that range are listed. indexed_list() returns a hash like that: %list = ( list => [ 'foo', 'bar', 'moo', ... ], start => 4 ); =cut sub indexed_list { my ($self, @range) = @_; return $self->call('indexed_list', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range )); } =head2 insert $moo->insert(4, 'foo.ogg', 'bar.mp3'); Insert items at a given position in the queue. =cut sub insert { my $self = shift; my $num = pop; my @items = @_; return $self->call('insert', RPC::XML::array->new( map { RPC::XML::base64->new($_) } @items ), RPC::XML::int->new( $num ) ); } =head2 is_looping $moo->toggle_loop_mode if $moo->is_looping; Check whether the loop mode is on or not. =cut sub is_looping { my $self = shift; return $self->call('is_looping'); } =head2 is_paused $moo->toggle_pause if $moo->is_paused; Check whether the current song is paused or not. =cut sub is_paused { my $self = shift; return $self->call('is_paused'); } =head2 is_queue_running if($moo->is_queue_running) { ...; } Check whether the queue consumption (advancement) is activated. =cut sub is_queue_running { my $self = shift; return $self->call('is_queue_running'); } =head2 last_queue_update $time = $moo->last_queue_update Return the time at which the song queue was last modified. =cut sub last_queue_update { my $self = shift; return $self->call('last_queue_update'); } =head2 length $length = $moo->length Return the number of items in the song queue. =cut sub length { my $self = shift; return $self->call('length'); } =head2 list @list = $moo->list(); @list = $moo->list(2); @list = $moo->list(4, 8); $list_ref = $moo->list() List the song queue's contents. If a range is specified, only the items that fall within that range are listed. Returns an array if called in list context or an array reference if it's called in scalar context. =cut sub list { my ($self, @range) = @_; my $list = $self->call('list', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range )); return wantarray ? @{$list} : $list; } =head2 move $moo->move(10, 4); $moo->move(4, 7, 1); Move a range of items to a new position within the queue. =cut sub move { my $self = shift; my $num = pop; my @range = @_; return $self->call('move', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range ), RPC::XML::int->new( $num ) ); } =head2 move_list $moo->move(3, 5, 7, 11); Move the items referenced by a list of positions to a new position. =cut sub move_list { my $self = shift; my $num = pop; my @range = @_; return $self->call('move_list', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range ), RPC::XML::int->new( $num ) ); } =head2 next $moo->next; $moo->next(5); Stop the current song (if any), and jumps ahead to a song that is currently in the queue. The skipped songs are recorded in the history as if they had been played. When called without arguments, this behaves very much like the skip() method, except that it will have an effect even if nothing is currently playing. =cut sub next { my ($self, $num) = @_; return $self->call('next', RPC::XML::int->new( $num || 1 )); } =head2 no_op $moo->no_op Do nothing, successfully. =cut sub no_op { my $self = shift; return $self->call('no_op'); } =head2 pause $moo->pause; Pause the currently playing song. =cut sub pause { my $self = shift; return $self->call('pause'); } =head2 prepend $moo->prepend('foo.ogg', 'bar.mp3'); Add items to the beginning of the queue. =cut sub prepend { my ($self, @items) = @_; return $self->call('prepend', RPC::XML::array->new( map { RPC::XML::base64->new($_) } @items )); } =head2 previous $moo->previous; $moo->previous(3); Stops the current song (if any), removes the most recently played song from the history, and puts these songs at the head of the queue. When loop mode is on, the songs at the tail of the song queue are used instead of the most recently played songs in the history. =cut sub previous { my ($self, $num) = @_; return $self->call('previous', RPC::XML::int->new( $num || 1 )); } =head2 putback $moo->putback; Place the currently playing song at the beginning of the queue. =cut sub putback { my $self = shift; return $self->call('putback'); } =head2 queue_length $length = $moo->queue_length; Return the number of items in the song queue. =cut sub queue_length { my $self = shift; return $self->call('queue_length'); } =head2 reconfigure $moo->reconfigure; Tell the server to reread its player configuration file. =cut sub reconfigure { my $self = shift; return $self->call('reconfigure'); } =head2 remove $moo->remove('regex'); $moo->remove('regex', 4); $moo->remove('regex', 1, 3); Remove all items that match the given regular expression. You can limit this operation by giving a range as described in crop() as last argument. =cut sub remove { my ($self, $regex, @range) = @_; return $self->call('remove', RPC::XML::base64->new( $regex ), RPC::XML::array->new( map { RPC::XML::int->new($_) } @range ) ); } =head2 replace $moo->replace('foo.ogg', 'bar.mp3'); Replace the contents of the queue with the given items. This is equivalent to calling clear() and prepend() in succession, except that this operation is atomic. =cut sub replace { my ($self, @items) = @_; return $self->call('replace', RPC::XML::array->new( map { RPC::XML::base64->new($_) } @items )); } =head2 reverse $moo->reverse; $moo->reverse(2); $moo->reverse(5, 7); Reverse the order of the items in the queue. You can limit this operation by giving a range as described in crop() as last argument. =cut sub reverse { my ($self, @range) = @_; return $self->call('reverse', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range )); } =head2 run_queue $moo->run_queue; Allows new songs to be played again after halt_queue() has been called. =cut sub run_queue { my $self = shift; return $self->call('run_queue'); } =head2 runqueue See run_queue(). =cut sub runqueue { my $self = shift; return $self->run_queue; } =head2 set_history_limit $moo->set_history_limit(44); Set the limit on the size of the history list stored in memory. =cut sub set_history_limit { my ($self, $limit) = @_; return $self->call('set_history_limit', RPC::XML::int->new( $limit )); } =head2 set_loop_mode $moo->set_loop_mode(0); $moo->set_loop_mode(1); Turn loop mode on or off. =cut sub set_loop_mode { my ($self, $mode) = @_; return $self->call('set_loop_mode', RPC::XML::boolean->new( $mode )); } =head2 showconfig my $config = $moo->showconfig; my %config = $moo->showconfig; Return the server's player configuration. If showconfig() is called in scalar context a scalar containing the textual description of the configuration is returned. If you call showconfig() in list context a hash which maps the configuration regular expression to the player commands is returned. =cut sub showconfig { my $self = shift; my $config = $self->call('showconfig'); return unless $config; return $config unless wantarray; my @config; foreach(split("\n", $config)) { s/^\s+//; chomp; push(@config, $_); } return @config; } =head2 shuffle $moo->shuffle; $moo->shuffle(2); $moo->shuffle(4, 6); Rearrange the contents of the queue into a random order. You can limit this operation by giving a range as described for crop() as last argument. =cut sub shuffle { my ($self, @range) = @_; return $self->call('shuffle', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range )); } =head2 skip $moo->skip; Skips the rest of the current song to play the next song in the queue. This only has an effect if there actually is a current song. =cut sub skip { my $self = shift; return $self->call('skip'); } =head2 sort $moo->sort; $moo->sort(2); $moo->sort(4, 6); Arrange the contents of the queue into sorted order. =cut sub sort { my ($self, @range) = @_; return $self->call('sort', RPC::XML::array->new( map { RPC::XML::int->new($_) } @range )); } =head2 stop $moo->stop; Stop playing the current song and stops new songs from playing. The current song is returned to the head of the song queue and is not recorded in the history list. If loop mode is on, the current song won't be placed at the end of the song queue when it is stopped. =cut sub stop { my $self = shift; return $self->call('stop'); } =head2 sub $moo->sub('regex', 'substitition'); $moo->sub('regex', 'substitition', 2); $moo->sub('regex', 'substitition', 1, 7); Perform a regular expression substitution on the items in the queue. You can limit this operation by giving a range as described for crop() as last argument. =cut sub sub { my ($self, $regex, $subst, @range) = @_; return $self->call('sub', RPC::XML::base64->new( $regex ), RPC::XML::base64->new( $subst ), RPC::XML::array->new( map { RPC::XML::int->new($_) } @range ) ); } =head2 sub_all $moo->sub_all('regex', 'substition'); $moo->sub_all('regex', 'substition', 2); $moo->sub_all('regex', 'substition', 1, 7); Performs a global regular expression substitution on the items in the queue. =cut sub sub_all { my ($self, $regex, $subst, @range) = @_; return $self->call('sub_all', RPC::XML::base64->new( $regex ), RPC::XML::base64->new( $subst ), RPC::XML::array->new( map { RPC::XML::int->new($_) } @range ) ); } =head2 swap $moo->swap( [7, 10], [ 5 ] ); Swap the items contained in one range with the items contained in the other range. The ranges for the swap() method needs to be passed as array references in contrast to other methods that use ranges. =cut sub swap { my ($self, $range1, $range2) = @_; return $self->call('swap', RPC::XML::array->new( map { RPC::XML::int->new($_) } @{$range1} ), RPC::XML::array->new( map { RPC::XML::int->new($_) } @{$range2} ) ); } =head2 listMethods @methods = $moo->listMethods; Return an array of all available XML-RPC methods on this server. =cut sub listMethods { my $self = shift; return $self->call('system.listMethods'); } =head2 methodHelp $help = $moo->methodHelp('sub'); Given the name of a method, return a help string. =cut sub methodHelp { my ($self, $method) = @_; return $self->call('syste.methodHelp', RPC::XML::string->new( $method ) ); } =head2 methodSignature $signature = $moo->methodSignature; Given the name of a method, return an array of legal signatures. Each signature is an array of scalars. The first item of each signature is the return type, and any others items are parameter types. =cut =cut sub methodSignature { my ($self, $method) = @_; return $self->call('system.methodSignature', RPC::XML::string->new( $method ) ); } =head2 multicall $moo->multicall(...); Process an array of calls, and return an array of results. This is not implemented yet. =cut sub multicall { my ($self, @cmds) = @_; require Carp; Carp::carp(__PACKAGE__."::multicall() isn't implemented yet."); #TODO } =head2 toggle_loop_mode $moo->toggle_loop_mode; Turn loop mode on if it is off, and turns it off if it is on. =cut sub toggle_loop_mode { my $self = shift; return $self->call('toggle_loop_mode'); } =head2 toggle_pause $moo->toggle_pause; Pause the current song if it is playing, and unpauses if it is paused. =cut sub toggle_pause { my $self = shift; return $self->call('toggle_pause'); } =head2 unpause $moo->unpause; Unpauses the current song. =cut sub unpause { my $self = shift; return $self->call('unpause'); } =head2 version $version = $moo->version; Return the Moosic server's version string. =cut sub version { my $self = shift; return $self->call('version'); } =head1 HELPER METHODS The following methods aren't methods defined by the moosic API but should be usefull when dealing with a moosic server. =head2 play $moo->play(); Start playing. If the playback is paused it will be unpaused. If the queue is stopped it will be started. =cut sub play { my $self = shift; return $self->unpause() if $self->is_paused(); return $self->run_queue(); } =head2 can_play $moo->append( $song ) if $moo->can_play( $song ); Takes a list of songs as argument and returns all items that can be played by the moosic daemon. =cut sub can_play { my $self = shift; my @can_play; my @config = $self->getconfig(); for my $track ( @_ ) { for( @config ) { push @can_play, $track if $track =~ qr/$_->[0]/; } } return @can_play; } package Audio::Moosic::Inet; use strict; use warnings; use base qw( Audio::Moosic ); sub connect { my ($self, $host, $port) = @_; return if $self->connected; my $location = "http://$host\:$port"; $self->disconnect; $self->{__rpc_xml_client} = RPC::XML::Client->new($location); $self->ping or return; $self->{__client_config} = { location => $location }; } package Audio::Moosic::Unix; use strict; use warnings; use base qw( Audio::Moosic ); sub connect { _init(); my ($self, $filename) = @_; return if $self->connected; $filename = ($ENV{HOME} || '/tmp') . '/.moosic/socket' unless $filename; my $location = "http://$filename"; $self->disconnect; $self->{__rpc_xml_client} = RPC::XML::Client->new($location); $self->ping or return; $self->{__client_config} = { location => $location }; } sub _init { unless( eval 'require LWP::Protocol::http::SocketUnix' ) { require Carp; Carp::croak('You need LWP::Protocol::http::SocketUnix to connect to a local'. " moosic server using a UNIX socket.\nPlease install it!"); } LWP::Protocol::implementor( http => 'LWP::Protocol::http::SocketUnix' ); } 1; =head1 BUGS =over 4 =item * check arguments more strictly expecially for constructors. =back If you find some others please report them to Florian Ragwitz Eflora@cpan.orgE =head1 TODO =over 4 =item * implement system_multicall =item * improve client_config =item * maybe use autoloader to load subs on demand create the method arguments from methodSignature. =back =head1 SEE ALSO moosic(1), moosicd(1), http://nanoo.org/~daniel/moosic/ =head1 AUTHOR Florian Ragwitz Erafl@debian.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2004-2008 by Florian Ragwitz 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.4 or, at your option, any later version of Perl 5 you may have available. =cut Audio-Moosic-0.10/README0000644000175000017500000000116110217621722013233 0ustar raflraflAudio-Moosic version 0.09 ========================= INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: LWP::Protocol::http::SocketUnix (only if you need to communicate with a local moosic server over an UNIX socket. COPYRIGHT AND LICENCE Copyright (C) 2004 by Florian Ragwitz 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.4 or, at your option, any later version of Perl 5 you may have available.