Finalized core13 and redirector fixes
authorChristian Schmidt <maniacikarus@ipfire.org>
Mon, 12 May 2008 13:58:31 +0000 (15:58 +0200)
committerChristian Schmidt <maniacikarus@ipfire.org>
Mon, 12 May 2008 13:58:31 +0000 (15:58 +0200)
Added some files to core14
First Beta of MPFire V3

20 files changed:
config/mpfire/perl/Accessor.pm [new file with mode: 0755]
config/mpfire/perl/Accessor/Fast.pm [new file with mode: 0755]
config/mpfire/perl/Accessor/Faster.pm [new file with mode: 0755]
config/mpfire/perl/Audio/MPD.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Collection.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Common.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Common/Item.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Common/Item/Directory.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Common/Item/Playlist.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Common/Item/Song.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Common/Stats.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Common/Status.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Common/Time.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Playlist.pm [new file with mode: 0644]
config/mpfire/perl/Audio/MPD/Test.pm [new file with mode: 0644]
config/mpfire/perl/Readonly.pm [new file with mode: 0644]
html/html/images/media-playback-start-all.png [new file with mode: 0644]
html/html/images/media-repeat.png [new file with mode: 0644]
html/html/images/media-shuffle.png [new file with mode: 0644]
html/html/images/mpfire/box.png [new file with mode: 0644]

diff --git a/config/mpfire/perl/Accessor.pm b/config/mpfire/perl/Accessor.pm
new file mode 100755 (executable)
index 0000000..7dcd00e
--- /dev/null
@@ -0,0 +1,675 @@
+package Class::Accessor;
+require 5.00502;
+use strict;
+$Class::Accessor::VERSION = '0.31';
+
+=head1 NAME
+
+  Class::Accessor - Automated accessor generation
+
+=head1 SYNOPSIS
+
+  package Employee;
+  use base qw(Class::Accessor);
+  Employee->mk_accessors(qw(name role salary));
+
+  # Meanwhile, in a nearby piece of code!
+  # Class::Accessor provides new().
+  my $mp = Foo->new({ name => "Marty", role => "JAPH" });
+
+  my $job = $mp->role;  # gets $mp->{role}
+  $mp->salary(400000);  # sets $mp->{salary} = 400000 (I wish)
+  
+  # like my @info = @{$mp}{qw(name role)}
+  my @info = $mp->get(qw(name role));
+  
+  # $mp->{salary} = 400000
+  $mp->set('salary', 400000);
+
+
+=head1 DESCRIPTION
+
+This module automagically generates accessors/mutators for your class.
+
+Most of the time, writing accessors is an exercise in cutting and
+pasting.  You usually wind up with a series of methods like this:
+
+    sub name {
+        my $self = shift;
+        if(@_) {
+            $self->{name} = $_[0];
+        }
+        return $self->{name};
+    }
+
+    sub salary {
+        my $self = shift;
+        if(@_) {
+            $self->{salary} = $_[0];
+        }
+        return $self->{salary};
+    }
+
+  # etc...
+
+One for each piece of data in your object.  While some will be unique,
+doing value checks and special storage tricks, most will simply be
+exercises in repetition.  Not only is it Bad Style to have a bunch of
+repetitious code, but its also simply not lazy, which is the real
+tragedy.
+
+If you make your module a subclass of Class::Accessor and declare your
+accessor fields with mk_accessors() then you'll find yourself with a
+set of automatically generated accessors which can even be
+customized!
+
+The basic set up is very simple:
+
+    package My::Class;
+    use base qw(Class::Accessor);
+    My::Class->mk_accessors( qw(foo bar car) );
+
+Done.  My::Class now has simple foo(), bar() and car() accessors
+defined.
+
+=head2 What Makes This Different?
+
+What makes this module special compared to all the other method
+generating modules (L<"SEE ALSO">)?  By overriding the get() and set()
+methods you can alter the behavior of the accessors class-wide.  Also,
+the accessors are implemented as closures which should cost a bit less
+memory than most other solutions which generate a new method for each
+accessor.
+
+
+=head1 METHODS
+
+=head2 new
+
+    my $obj = Class->new;
+    my $obj = $other_obj->new;
+
+    my $obj = Class->new(\%fields);
+    my $obj = $other_obj->new(\%fields);
+
+Class::Accessor provides a basic constructor.  It generates a
+hash-based object and can be called as either a class method or an
+object method.  
+
+It takes an optional %fields hash which is used to initialize the
+object (handy if you use read-only accessors).  The fields of the hash
+correspond to the names of your accessors, so...
+
+    package Foo;
+    use base qw(Class::Accessor);
+    Foo->mk_accessors('foo');
+
+    my $obj = Class->new({ foo => 42 });
+    print $obj->foo;    # 42
+
+however %fields can contain anything, new() will shove them all into
+your object.  Don't like it?  Override it.
+
+=cut
+
+sub new {
+    my($proto, $fields) = @_;
+    my($class) = ref $proto || $proto;
+
+    $fields = {} unless defined $fields;
+
+    # make a copy of $fields.
+    bless {%$fields}, $class;
+}
+
+=head2 mk_accessors
+
+    Class->mk_accessors(@fields);
+
+This creates accessor/mutator methods for each named field given in
+@fields.  Foreach field in @fields it will generate two accessors.
+One called "field()" and the other called "_field_accessor()".  For
+example:
+
+    # Generates foo(), _foo_accessor(), bar() and _bar_accessor().
+    Class->mk_accessors(qw(foo bar));
+
+See L<CAVEATS AND TRICKS/"Overriding autogenerated accessors">
+for details.
+
+=cut
+
+sub mk_accessors {
+    my($self, @fields) = @_;
+
+    $self->_mk_accessors('rw', @fields);
+}
+
+
+{
+    no strict 'refs';
+
+    sub _mk_accessors {
+        my($self, $access, @fields) = @_;
+        my $class = ref $self || $self;
+        my $ra = $access eq 'rw' || $access eq 'ro';
+        my $wa = $access eq 'rw' || $access eq 'wo';
+
+        foreach my $field (@fields) {
+            my $accessor_name = $self->accessor_name_for($field);
+            my $mutator_name = $self->mutator_name_for($field);
+            if( $accessor_name eq 'DESTROY' or $mutator_name eq 'DESTROY' ) {
+                $self->_carp("Having a data accessor named DESTROY  in '$class' is unwise.");
+            }
+            if ($accessor_name eq $mutator_name) {
+                my $accessor;
+                if ($ra && $wa) {
+                    $accessor = $self->make_accessor($field);
+                } elsif ($ra) {
+                    $accessor = $self->make_ro_accessor($field);
+                } else {
+                    $accessor = $self->make_wo_accessor($field);
+                }
+                unless (defined &{"${class}::$accessor_name"}) {
+                    *{"${class}::$accessor_name"} = $accessor;
+                }
+                if ($accessor_name eq $field) {
+                    # the old behaviour
+                    my $alias = "_${field}_accessor";
+                    *{"${class}::$alias"} = $accessor unless defined &{"${class}::$alias"};
+                }
+            } else {
+                if ($ra and not defined &{"${class}::$accessor_name"}) {
+                    *{"${class}::$accessor_name"} = $self->make_ro_accessor($field);
+                }
+                if ($wa and not defined &{"${class}::$mutator_name"}) {
+                    *{"${class}::$mutator_name"} = $self->make_wo_accessor($field);
+                }
+            }
+        }
+    }
+
+    sub follow_best_practice {
+        my($self) = @_;
+        my $class = ref $self || $self;
+        *{"${class}::accessor_name_for"}  = \&best_practice_accessor_name_for;
+        *{"${class}::mutator_name_for"}  = \&best_practice_mutator_name_for;
+    }
+
+}
+
+=head2 mk_ro_accessors
+
+  Class->mk_ro_accessors(@read_only_fields);
+
+Same as mk_accessors() except it will generate read-only accessors
+(ie. true accessors).  If you attempt to set a value with these
+accessors it will throw an exception.  It only uses get() and not
+set().
+
+    package Foo;
+    use base qw(Class::Accessor);
+    Class->mk_ro_accessors(qw(foo bar));
+
+    # Let's assume we have an object $foo of class Foo...
+    print $foo->foo;  # ok, prints whatever the value of $foo->{foo} is
+    $foo->foo(42);    # BOOM!  Naughty you.
+
+
+=cut
+
+sub mk_ro_accessors {
+    my($self, @fields) = @_;
+
+    $self->_mk_accessors('ro', @fields);
+}
+
+=head2 mk_wo_accessors
+
+  Class->mk_wo_accessors(@write_only_fields);
+
+Same as mk_accessors() except it will generate write-only accessors
+(ie. mutators).  If you attempt to read a value with these accessors
+it will throw an exception.  It only uses set() and not get().
+
+B<NOTE> I'm not entirely sure why this is useful, but I'm sure someone
+will need it.  If you've found a use, let me know.  Right now its here
+for orthoginality and because its easy to implement.
+
+    package Foo;
+    use base qw(Class::Accessor);
+    Class->mk_wo_accessors(qw(foo bar));
+
+    # Let's assume we have an object $foo of class Foo...
+    $foo->foo(42);      # OK.  Sets $self->{foo} = 42
+    print $foo->foo;    # BOOM!  Can't read from this accessor.
+
+=cut
+
+sub mk_wo_accessors {
+    my($self, @fields) = @_;
+
+    $self->_mk_accessors('wo', @fields);
+}
+
+=head1 DETAILS
+
+An accessor generated by Class::Accessor looks something like
+this:
+
+    # Your foo may vary.
+    sub foo {
+        my($self) = shift;
+        if(@_) {    # set
+            return $self->set('foo', @_);
+        }
+        else {
+            return $self->get('foo');
+        }
+    }
+
+Very simple.  All it does is determine if you're wanting to set a
+value or get a value and calls the appropriate method.
+Class::Accessor provides default get() and set() methods which
+your class can override.  They're detailed later.
+
+=head2 follow_best_practice
+
+In Damian's Perl Best Practices book he recommends separate get and set methods
+with the prefix set_ and get_ to make it explicit what you intend to do.  If you
+want to create those accessor methods instead of the default ones, call:
+
+    __PACKAGE__->follow_best_practice
+
+=head2 accessor_name_for / mutator_name_for
+
+You may have your own crazy ideas for the names of the accessors, so you can
+make those happen by overriding C<accessor_name_for> and C<mutator_name_for> in
+your subclass.  (I copied that idea from Class::DBI.)
+
+=cut
+
+sub best_practice_accessor_name_for {
+    my ($class, $field) = @_;
+    return "get_$field";
+}
+
+sub best_practice_mutator_name_for {
+    my ($class, $field) = @_;
+    return "set_$field";
+}
+
+sub accessor_name_for {
+    my ($class, $field) = @_;
+    return $field;
+}
+
+sub mutator_name_for {
+    my ($class, $field) = @_;
+    return $field;
+}
+
+=head2 Modifying the behavior of the accessor
+
+Rather than actually modifying the accessor itself, it is much more
+sensible to simply override the two key methods which the accessor
+calls.  Namely set() and get().
+
+If you -really- want to, you can override make_accessor().
+
+=head2 set
+
+    $obj->set($key, $value);
+    $obj->set($key, @values);
+
+set() defines how generally one stores data in the object.
+
+override this method to change how data is stored by your accessors.
+
+=cut
+
+sub set {
+    my($self, $key) = splice(@_, 0, 2);
+
+    if(@_ == 1) {
+        $self->{$key} = $_[0];
+    }
+    elsif(@_ > 1) {
+        $self->{$key} = [@_];
+    }
+    else {
+        $self->_croak("Wrong number of arguments received");
+    }
+}
+
+=head2 get
+
+    $value  = $obj->get($key);
+    @values = $obj->get(@keys);
+
+get() defines how data is retreived from your objects.
+
+override this method to change how it is retreived.
+
+=cut
+
+sub get {
+    my $self = shift;
+
+    if(@_ == 1) {
+        return $self->{$_[0]};
+    }
+    elsif( @_ > 1 ) {
+        return @{$self}{@_};
+    }
+    else {
+        $self->_croak("Wrong number of arguments received");
+    }
+}
+
+=head2 make_accessor
+
+    $accessor = Class->make_accessor($field);
+
+Generates a subroutine reference which acts as an accessor for the given
+$field.  It calls get() and set().
+
+If you wish to change the behavior of your accessors, try overriding
+get() and set() before you start mucking with make_accessor().
+
+=cut
+
+sub make_accessor {
+    my ($class, $field) = @_;
+
+    # Build a closure around $field.
+    return sub {
+        my $self = shift;
+
+        if(@_) {
+            return $self->set($field, @_);
+        }
+        else {
+            return $self->get($field);
+        }
+    };
+}
+
+=head2 make_ro_accessor
+
+    $read_only_accessor = Class->make_ro_accessor($field);
+
+Generates a subroutine refrence which acts as a read-only accessor for
+the given $field.  It only calls get().
+
+Override get() to change the behavior of your accessors.
+
+=cut
+
+sub make_ro_accessor {
+    my($class, $field) = @_;
+
+    return sub {
+        my $self = shift;
+
+        if (@_) {
+            my $caller = caller;
+            $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
+        }
+        else {
+            return $self->get($field);
+        }
+    };
+}
+
+=head2 make_wo_accessor
+
+    $read_only_accessor = Class->make_wo_accessor($field);
+
+Generates a subroutine refrence which acts as a write-only accessor
+(mutator) for the given $field.  It only calls set().
+
+Override set() to change the behavior of your accessors.
+
+=cut
+
+sub make_wo_accessor {
+    my($class, $field) = @_;
+
+    return sub {
+        my $self = shift;
+
+        unless (@_) {
+            my $caller = caller;
+            $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
+        }
+        else {
+            return $self->set($field, @_);
+        }
+    };
+}
+
+=head1 EXCEPTIONS
+
+If something goes wrong Class::Accessor will warn or die by calling Carp::carp
+or Carp::croak.  If you don't like this you can override _carp() and _croak() in
+your subclass and do whatever else you want.
+
+=cut
+
+use Carp ();
+
+sub _carp {
+    my ($self, $msg) = @_;
+    Carp::carp($msg || $self);
+    return;
+}
+
+sub _croak {
+    my ($self, $msg) = @_;
+    Carp::croak($msg || $self);
+    return;
+}
+
+=head1 EFFICIENCY
+
+Class::Accessor does not employ an autoloader, thus it is much faster
+than you'd think.  Its generated methods incur no special penalty over
+ones you'd write yourself.
+
+  accessors:
+               Rate   Basic Average    Fast  Faster  Direct
+  Basic    189150/s      --    -42%    -51%    -55%    -89%
+  Average  327679/s     73%      --    -16%    -22%    -82%
+  Fast     389212/s    106%     19%      --     -8%    -78%
+  Faster   421646/s    123%     29%      8%      --    -76%
+  Direct  1771243/s    836%    441%    355%    320%      --
+
+  mutators:
+               Rate   Basic Average    Fast  Faster  Direct
+  Basic    173769/s      --    -34%    -53%    -59%    -90%
+  Average  263046/s     51%      --    -29%    -38%    -85%
+  Fast     371158/s    114%     41%      --    -13%    -78%
+  Faster   425821/s    145%     62%     15%      --    -75%
+  Direct  1699081/s    878%    546%    358%    299%      --
+
+Class::Accessor::Fast is faster than methods written by an average programmer
+(where "average" is based on Schwern's example code).
+
+Class::Accessor is slower than average, but more flexible.
+
+Class::Accessor::Faster is even faster than Class::Accessor::Fast.  It uses an
+array internally, not a hash.  This could be a good or bad feature depending on
+your point of view.
+
+Direct hash access is, of course, much faster than all of these, but it
+provides no encapsulation.
+
+Of course, its not as simple as saying "Class::Accessor is slower than
+average".  These are benchmarks for a simple accessor.  If your accessors do
+any sort of complicated work (such as talking to a database or writing to a
+file) the time spent doing that work will quickly swamp the time spend just
+calling the accessor.  In that case, Class::Accessor and the ones you write
+will be roughly the same speed.
+
+
+=head1 EXAMPLES
+
+Here's an example of generating an accessor for every public field of
+your class.
+
+    package Altoids;
+    
+    use base qw(Class::Accessor Class::Fields);
+    use fields qw(curiously strong mints);
+    Altoids->mk_accessors( Altoids->show_fields('Public') );
+
+    sub new {
+        my $proto = shift;
+        my $class = ref $proto || $proto;
+        return fields::new($class);
+    }
+
+    my Altoids $tin = Altoids->new;
+
+    $tin->curiously('Curiouser and curiouser');
+    print $tin->{curiously};    # prints 'Curiouser and curiouser'
+
+    
+    # Subclassing works, too.
+    package Mint::Snuff;
+    use base qw(Altoids);
+
+    my Mint::Snuff $pouch = Mint::Snuff->new;
+    $pouch->strong('Blow your head off!');
+    print $pouch->{strong};     # prints 'Blow your head off!'
+
+
+Here's a simple example of altering the behavior of your accessors.
+
+    package Foo;
+    use base qw(Class::Accessor);
+    Foo->mk_accessor(qw(this that up down));
+
+    sub get {
+        my $self = shift;
+
+        # Note every time someone gets some data.
+        print STDERR "Getting @_\n";
+
+        $self->SUPER::get(@_);
+    }
+
+    sub set {
+        my ($self, $key) = splice(@_, 0, 2);
+
+        # Note every time someone sets some data.
+        print STDERR "Setting $key to @_\n";
+
+        $self->SUPER::set($key, @_);
+    }
+
+
+=head1 CAVEATS AND TRICKS
+
+Class::Accessor has to do some internal wackiness to get its
+job done quickly and efficiently.  Because of this, there's a few
+tricks and traps one must know about.
+
+Hey, nothing's perfect.
+
+=head2 Don't make a field called DESTROY
+
+This is bad.  Since DESTROY is a magical method it would be bad for us
+to define an accessor using that name.  Class::Accessor will
+carp if you try to use it with a field named "DESTROY".
+
+=head2 Overriding autogenerated accessors
+
+You may want to override the autogenerated accessor with your own, yet
+have your custom accessor call the default one.  For instance, maybe
+you want to have an accessor which checks its input.  Normally, one
+would expect this to work:
+
+    package Foo;
+    use base qw(Class::Accessor);
+    Foo->mk_accessors(qw(email this that whatever));
+
+    # Only accept addresses which look valid.
+    sub email {
+        my($self) = shift;
+        my($email) = @_;
+
+        if( @_ ) {  # Setting
+            require Email::Valid;
+            unless( Email::Valid->address($email) ) {
+                carp("$email doesn't look like a valid address.");
+                return;
+            }
+        }
+
+        return $self->SUPER::email(@_);
+    }
+
+There's a subtle problem in the last example, and its in this line:
+
+    return $self->SUPER::email(@_);
+
+If we look at how Foo was defined, it called mk_accessors() which
+stuck email() right into Foo's namespace.  There *is* no
+SUPER::email() to delegate to!  Two ways around this... first is to
+make a "pure" base class for Foo.  This pure class will generate the
+accessors and provide the necessary super class for Foo to use:
+
+    package Pure::Organic::Foo;
+    use base qw(Class::Accessor);
+    Pure::Organic::Foo->mk_accessors(qw(email this that whatever));
+
+    package Foo;
+    use base qw(Pure::Organic::Foo);
+
+And now Foo::email() can override the generated
+Pure::Organic::Foo::email() and use it as SUPER::email().
+
+This is probably the most obvious solution to everyone but me.
+Instead, what first made sense to me was for mk_accessors() to define
+an alias of email(), _email_accessor().  Using this solution,
+Foo::email() would be written with:
+
+    return $self->_email_accessor(@_);
+
+instead of the expected SUPER::email().
+
+
+=head1 AUTHORS
+
+Copyright 2007 Marty Pauley <marty+perl@kasei.com>
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.  That means either (a) the GNU General Public
+License or (b) the Artistic License.
+
+=head2 ORIGINAL AUTHOR
+
+Michael G Schwern <schwern@pobox.com>
+
+=head2 THANKS
+
+Liz and RUZ for performance tweaks.
+
+Tels, for his big feature request/bug report.
+
+
+=head1 SEE ALSO
+
+L<Class::Accessor::Fast>
+
+These are some modules which do similar things in different ways
+L<Class::Struct>, L<Class::Methodmaker>, L<Class::Generate>,
+L<Class::Class>, L<Class::Contract>
+
+L<Class::DBI> for an example of this module in use.
+
+=cut
+
+1;
diff --git a/config/mpfire/perl/Accessor/Fast.pm b/config/mpfire/perl/Accessor/Fast.pm
new file mode 100755 (executable)
index 0000000..6522923
--- /dev/null
@@ -0,0 +1,94 @@
+package Class::Accessor::Fast;
+use base 'Class::Accessor';
+use strict;
+$Class::Accessor::Fast::VERSION = '0.31';
+
+=head1 NAME
+
+Class::Accessor::Fast - Faster, but less expandable, accessors
+
+=head1 SYNOPSIS
+
+  package Foo;
+  use base qw(Class::Accessor::Fast);
+
+  # The rest is the same as Class::Accessor but without set() and get().
+
+=head1 DESCRIPTION
+
+This is a faster but less expandable version of Class::Accessor.
+Class::Accessor's generated accessors require two method calls to accompish
+their task (one for the accessor, another for get() or set()).
+Class::Accessor::Fast eliminates calling set()/get() and does the access itself,
+resulting in a somewhat faster accessor.
+
+The downside is that you can't easily alter the behavior of your
+accessors, nor can your subclasses.  Of course, should you need this
+later, you can always swap out Class::Accessor::Fast for
+Class::Accessor.
+
+Read the documentation for Class::Accessor for more info.
+
+=cut
+
+sub make_accessor {
+    my($class, $field) = @_;
+
+    return sub {
+        return $_[0]->{$field} if @_ == 1;
+        return $_[0]->{$field} = $_[1] if @_ == 2;
+        return (shift)->{$field} = \@_;
+    };
+}
+
+
+sub make_ro_accessor {
+    my($class, $field) = @_;
+
+    return sub {
+        return $_[0]->{$field} if @_ == 1;
+        my $caller = caller;
+        $_[0]->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
+    };
+}
+
+
+sub make_wo_accessor {
+    my($class, $field) = @_;
+
+    return sub {
+        if (@_ == 1) {
+            my $caller = caller;
+            $_[0]->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
+        }
+        else {
+            return $_[0]->{$field} = $_[1] if @_ == 2;
+            return (shift)->{$field} = \@_;
+        }
+    };
+}
+
+
+=head1 EFFICIENCY
+
+L<Class::Accessor/EFFICIENCY> for an efficiency comparison.
+
+=head1 AUTHORS
+
+Copyright 2007 Marty Pauley <marty+perl@kasei.com>
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.  That means either (a) the GNU General Public
+License or (b) the Artistic License.
+
+=head2 ORIGINAL AUTHOR
+
+Michael G Schwern <schwern@pobox.com>
+
+=head1 SEE ALSO
+
+L<Class::Accessor>
+
+=cut
+
+1;
diff --git a/config/mpfire/perl/Accessor/Faster.pm b/config/mpfire/perl/Accessor/Faster.pm
new file mode 100755 (executable)
index 0000000..8f81ff9
--- /dev/null
@@ -0,0 +1,105 @@
+package Class::Accessor::Faster;
+use base 'Class::Accessor';
+use strict;
+$Class::Accessor::Faster::VERSION = '0.31';
+
+=head1 NAME
+
+Class::Accessor::Faster - Even faster, but less expandable, accessors
+
+=head1 SYNOPSIS
+
+  package Foo;
+  use base qw(Class::Accessor::Faster);
+
+=head1 DESCRIPTION
+
+This is a faster but less expandable version of Class::Accessor::Fast.
+
+Class::Accessor's generated accessors require two method calls to accompish
+their task (one for the accessor, another for get() or set()).
+
+Class::Accessor::Fast eliminates calling set()/get() and does the access itself,
+resulting in a somewhat faster accessor.
+
+Class::Accessor::Faster uses an array reference underneath to be faster.
+
+Read the documentation for Class::Accessor for more info.
+
+=cut
+
+my %slot;
+sub _slot {
+    my($class, $field) = @_;
+    my $n = $slot{$class}->{$field};
+    return $n if defined $n;
+    $n = keys %{$slot{$class}};
+    $slot{$class}->{$field} = $n;
+    return $n;
+}
+
+sub new {
+    my($proto, $fields) = @_;
+    my($class) = ref $proto || $proto;
+    my $self = bless [], $class;
+
+    $fields = {} unless defined $fields;
+    for my $k (keys %$fields) {
+        my $n = $class->_slot($k);
+        $self->[$n] = $fields->{$k};
+    }
+    return $self;
+}
+
+sub make_accessor {
+    my($class, $field) = @_;
+    my $n = $class->_slot($field);
+    return sub {
+        return $_[0]->[$n] if @_ == 1;
+        return $_[0]->[$n] = $_[1] if @_ == 2;
+        return (shift)->[$n] = \@_;
+    };
+}
+
+
+sub make_ro_accessor {
+    my($class, $field) = @_;
+    my $n = $class->_slot($field);
+    return sub {
+        return $_[0]->[$n] if @_ == 1;
+        my $caller = caller;
+        $_[0]->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
+    };
+}
+
+
+sub make_wo_accessor {
+    my($class, $field) = @_;
+    my $n = $class->_slot($field);
+    return sub {
+        if (@_ == 1) {
+            my $caller = caller;
+            $_[0]->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
+        } else {
+            return $_[0]->[$n] = $_[1] if @_ == 2;
+            return (shift)->[$n] = \@_;
+        }
+    };
+}
+
+
+=head1 AUTHORS
+
+Copyright 2007 Marty Pauley <marty+perl@kasei.com>
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.  That means either (a) the GNU General Public
+License or (b) the Artistic License.
+
+=head1 SEE ALSO
+
+L<Class::Accessor>
+
+=cut
+
+1;
diff --git a/config/mpfire/perl/Audio/MPD.pm b/config/mpfire/perl/Audio/MPD.pm
new file mode 100644 (file)
index 0000000..e1c00db
--- /dev/null
@@ -0,0 +1,897 @@
+#
+# This file is part of Audio::MPD
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD;
+
+use warnings;
+use strict;
+
+use Audio::MPD::Collection;
+use Audio::MPD::Common::Item;
+use Audio::MPD::Common::Stats;
+use Audio::MPD::Common::Status;
+use Audio::MPD::Playlist;
+use Encode;
+use IO::Socket;
+use Readonly;
+
+
+use base qw[ Class::Accessor::Fast Exporter ];
+__PACKAGE__->mk_accessors(
+    qw[ _conntype _host _password _port _socket
+        collection playlist version ] );
+
+
+our $VERSION = '0.19.1';
+
+Readonly our $REUSE => 1;
+Readonly our $ONCE  => 0;
+
+our @EXPORT = qw[ $REUSE $ONCE ];
+
+
+#--
+# Constructor
+
+#
+# my $mpd = Audio::MPD->new( [%opts] )
+#
+# This is the constructor for Audio::MPD. One can specify the following
+# options:
+#   - hostname => $hostname : defaults to environment var MPD_HOST, then to 'localhost'
+#   - port     => $port     : defaults to env var MPD_PORT, then to 6600
+#   - password => $password : defaults to env var MPD_PASSWORD, then to ''
+#   - conntype => $type     : how the connection to mpd server is handled. it can be
+#               either $REUSE: reuse the same connection
+#                    or $ONCE: open a new connection per command (default)
+#   
+sub new {
+    my ($class, %opts) = @_;
+
+    # use mpd defaults.
+    my ($default_password, $default_host) = split( '@', $ENV{MPD_HOST} )
+       if exists $ENV{MPD_HOST} && $ENV{MPD_HOST} =~ /@/;
+    my $host     = $opts{host}     || $default_host      || $ENV{MPD_HOST} || 'localhost';
+    my $port     = $opts{port}     || $ENV{MPD_PORT}     || '6600';
+    my $password = $opts{password} || $ENV{MPD_PASSWORD} || $default_password || '';
+
+    # create & bless the object.
+    my $self = {
+        _host     => $host,
+        _port     => $port,
+        _password => $password,
+        _conntype => exists $opts{conntype} ? $opts{conntype} : $ONCE,
+    };
+    bless $self, $class;
+
+    # create the connection if conntype is set to $REUSE
+    $self->_connect_to_mpd_server if $self->_conntype == $REUSE;
+
+
+    # create the helper objects and store them.
+    $self->collection( Audio::MPD::Collection->new($self) );
+    $self->playlist  ( Audio::MPD::Playlist->new($self) );
+
+    # try to issue a ping to test connection - this can die.
+    $self->ping;
+
+    return $self;
+}
+
+
+#--
+# Private methods
+
+
+#
+# $mpd->_connect_to_mpd_server;
+#
+# This method connects to the mpd server. It can die on several conditions:
+#  - if the server cannot be reached,
+#  - if it's not an mpd server,
+#  - or if the password is incorrect,
+#
+sub _connect_to_mpd_server {
+    my ($self) = @_;
+
+    # try to connect to mpd.
+    my $socket = IO::Socket::INET->new(
+        PeerAddr => $self->_host,
+        PeerPort => $self->_port,
+    )
+    or die "Could not create socket: $!\n";
+
+    # parse version information.
+    my $line = $socket->getline;
+    chomp $line;
+    die "Not a mpd server - welcome string was: [$line]\n"
+        if $line !~ /^OK MPD (.+)$/;
+    $self->version($1);
+
+    # send password.
+    if ( $self->_password ) {
+        $socket->print( 'password ' . encode('utf-8', $self->_password) . "\n" );
+        $line = $socket->getline;
+        die $line if $line =~ s/^ACK //;
+    }
+
+    # save socket
+    $self->_socket($socket);
+}
+
+
+#
+# my @result = $mpd->_send_command( $command );
+#
+# This method is central to the module. It is responsible for interacting with
+# mpd by sending the $command and reading output - that will be returned as an
+# array of chomped lines (status line will not be returned).
+#
+# This method can die on several conditions:
+#  - if the server cannot be reached,
+#  - if it's not an mpd server,
+#  - if the password is incorrect,
+#  - or if the command is an invalid mpd command.
+# In the latter case, the mpd error message will be returned.
+#
+sub _send_command {
+    my ($self, $command) = @_;
+
+    $self->_connect_to_mpd_server if $self->_conntype == $ONCE;
+    my $socket = $self->_socket;
+
+    # ok, now we're connected - let's issue the command.
+    $socket->print( encode('utf-8', $command) );
+    my @output;
+    while (defined ( my $line = $socket->getline ) ) {
+        chomp $line;
+        die $line if $line =~ s/^ACK //; # oops - error.
+        last if $line =~ /^OK/;          # end of output.
+        push @output, decode('utf-8', $line);
+    }
+
+    # close the socket.
+    $socket->close if $self->_conntype == $ONCE;
+
+    return @output;
+}
+
+
+#
+# my @items = $mpd->_cooked_command_as_items( $command );
+#
+# Lots of Audio::MPD methods are using _send_command() and then parse the
+# output as a collection of AMC::Item. This method is meant to factorize
+# this code, and will parse the raw output of _send_command() in a cooked
+# list of items.
+#
+sub _cooked_command_as_items {
+    my ($self, $command) = @_;
+
+    my @lines = $self->_send_command($command);
+    my (@items, %param);
+
+    # parse lines in reverse order since "file:" or "directory:" lines
+    # come first. therefore, let's first store every other parameter,
+    # and the last line will trigger the object creation.
+    # of course, since we want to preserve the playlist order, this means
+    # that we're going to unshift the objects instead of push.
+    foreach my $line (reverse @lines) {
+        my ($k,$v) = split /:\s/, $line, 2;
+        $param{$k} = $v;
+        next unless $k eq 'file' || $k eq 'directory' || $k eq 'playlist'; # last param of item
+        unshift @items, Audio::MPD::Common::Item->new(%param);
+        %param = ();
+    }
+
+    return @items;
+}
+
+
+sub _cooked_command_as_filename {
+    my ($self, $command) = @_;
+
+    my @lines = $self->_send_command($command);
+    my (@items, %param);
+
+    # parse lines in reverse order since "file:" or "directory:" lines
+    # come first. therefore, let's first store every other parameter,
+    # and the last line will trigger the object creation.
+    # of course, since we want to preserve the playlist order, this means
+    # that we're going to unshift the objects instead of push.
+    foreach my $line (@lines) {
+        my ($k,$v) = split /:\s/, $line, 2;
+        if ( $k eq 'file'){$param{$k} = $v;}
+        unshift @items, $param{'file'};
+        %param = ();
+    }
+
+    return @items;
+}
+
+#
+# my %hash = $mpd->_cooked_command_as_kv( $command );
+#
+# Lots of Audio::MPD methods are using _send_command() and then parse the
+# output to get a list of key / value (with the colon ":" acting as separator).
+# This method is meant to factorize this code, and will parse the raw output
+# of _send_command() in a cooked hash.
+#
+sub _cooked_command_as_kv {
+    my ($self, $command) = @_;
+    my %hash =
+        map { split(/:\s/, $_, 2) }
+        $self->_send_command($command);
+    return %hash;
+}
+
+#
+# my @list = $mpd->_cooked_command_strip_first_field( $command );
+#
+# Lots of Audio::MPD methods are using _send_command() and then parse the
+# output to remove the first field (with the colon ":" acting as separator).
+# This method is meant to factorize this code, and will parse the raw output
+# of _send_command() in a cooked list of strings.
+#
+sub _cooked_command_strip_first_field {
+    my ($self, $command) = @_;
+
+    my @list =
+        map { ( split(/:\s+/, $_, 2) )[1] }
+        $self->_send_command($command);
+    return @list;
+}
+
+
+#--
+# Public methods
+
+# -- MPD interaction: general commands
+
+#
+# $mpd->ping;
+#
+# Sends a ping command to the mpd server.
+#
+sub ping {
+    my ($self) = @_;
+    $self->_send_command( "ping\n" );
+}
+
+
+#
+# my $version = $mpd->version;
+#
+# Return version of MPD server's connected.
+#
+# sub version {} # implemented as an accessor.
+#
+
+
+#
+# $mpd->kill;
+#
+# Send a message to the MPD server telling it to shut down.
+#
+sub kill {
+    my ($self) = @_;
+    $self->_send_command("kill\n");
+}
+
+
+#
+# $mpd->password( [$password] )
+#
+# Change password used to communicate with MPD server to $password.
+# Empty string is assumed if $password is not supplied.
+#
+sub password {
+    my ($self, $passwd) = @_;
+    $passwd ||= '';
+    $self->_password($passwd);
+    $self->ping; # ping sends a command, and thus the password is sent
+}
+
+
+#
+# $mpd->updatedb( [$path] );
+#
+# Force mpd to rescan its collection. If $path (relative to MPD's music
+# directory) is supplied, MPD will only scan it - otherwise, MPD will rescan
+# its whole collection.
+#
+sub updatedb {
+    my ($self, $path) = @_;
+    $path ||= '';
+    $self->_send_command("update $path\n");
+}
+
+
+#
+# my @handlers = $mpd->urlhandlers;
+#
+# Return an array of supported URL schemes.
+#
+sub urlhandlers {
+    my ($self) = @_;
+    return $self->_cooked_command_strip_first_field("urlhandlers\n");
+}
+
+
+# -- MPD interaction: handling volume & output
+
+#
+# $mpd->volume( [+][-]$volume );
+#
+# Sets the audio output volume percentage to absolute $volume.
+# If $volume is prefixed by '+' or '-' then the volume is changed relatively
+# by that value.
+#
+sub volume {
+    my ($self, $volume) = @_;
+
+    if ($volume =~ /^(-|\+)(\d+)/ )  {
+        my $current = $self->status->volume;
+        $volume = $1 eq '+' ? $current + $2 : $current - $2;
+    }
+    $self->_send_command("setvol $volume\n");
+}
+
+
+#
+# $mpd->output_enable( $output );
+#
+# Enable the specified audio output. $output is the ID of the audio output.
+#
+sub output_enable {
+    my ($self, $output) = @_;
+    $self->_send_command("enableoutput $output\n");
+}
+
+
+#
+# $mpd->output_disable( $output );
+#
+# Disable the specified audio output. $output is the ID of the audio output.
+#
+sub output_disable {
+    my ($self, $output) = @_;
+    $self->_send_command("disableoutput $output\n");
+}
+
+
+
+# -- MPD interaction: retrieving info from current state
+
+#
+# $mpd->stats;
+#
+# Return an AMC::Stats object with the current statistics of MPD.
+#
+sub stats {
+    my ($self) = @_;
+    my %kv = $self->_cooked_command_as_kv( "stats\n" );
+    return Audio::MPD::Common::Stats->new(\%kv);
+}
+
+
+#
+# my $status = $mpd->status;
+#
+# Return an AMC::Status object with various information on current
+# MPD server settings. Check the embedded pod for more information on the
+# available accessors.
+#
+sub status {
+    my ($self) = @_;
+    my %kv = $self->_cooked_command_as_kv( "status\n" );
+    my $status = Audio::MPD::Common::Status->new( \%kv );
+    return $status;
+}
+
+
+#
+# my $song = $mpd->current;
+#
+# Return an AMC::Item::Song representing the song currently playing.
+#
+sub current {
+    my ($self) = @_;
+    my ($item) = $self->_cooked_command_as_items("currentsong\n");
+    return $item;
+}
+
+
+#
+# my $song = $mpd->song( [$song] )
+#
+# Return an AMC::Item::Song representing the song number $song.
+# If $song is not supplied, returns the current song.
+#
+sub song {
+    my ($self, $song) = @_;
+    return $self->current unless defined $song;
+    my ($item) = $self->_cooked_command_as_items("playlistinfo $song\n");
+    return $item;
+}
+
+
+#
+# my $song = $mpd->songid( [$songid] )
+#
+# Return an AMC::Item::Song representing the song with id $songid.
+# If $songid is not supplied, returns the current song.
+#
+sub songid {
+    my ($self, $songid) = @_;
+    return $self->current unless defined $songid;
+    my ($item) = $self->_cooked_command_as_items("playlistid $songid\n");
+    return $item;
+}
+
+
+# -- MPD interaction: altering settings
+
+#
+# $mpd->repeat( [$repeat] );
+#
+# Set the repeat mode to $repeat (1 or 0). If $repeat is not specified then
+# the repeat mode is toggled.
+#
+sub repeat {
+    my ($self, $mode) = @_;
+
+    $mode = not $self->status->repeat
+        unless defined $mode; # toggle if no param
+    $mode = $mode ? 1 : 0;               # force integer
+    $self->_send_command("repeat $mode\n");
+}
+
+
+#
+# $mpd->random( [$random] );
+#
+# Set the random mode to $random (1 or 0). If $random is not specified then
+# the random mode is toggled.
+#
+sub random {
+    my ($self, $mode) = @_;
+
+    $mode = not $self->status->random
+        unless defined $mode; # toggle if no param
+    $mode = $mode ? 1 : 0;               # force integer
+    $self->_send_command("random $mode\n");
+}
+
+
+#
+# $mpd->fade( [$seconds] );
+#
+# Enable crossfading and set the duration of crossfade between songs. If
+# $seconds is not specified or $seconds is 0, then crossfading is disabled.
+#
+sub fade {
+    my ($self, $value) = @_;
+    $value ||= 0;
+    $self->_send_command("crossfade $value\n");
+}
+
+
+# -- MPD interaction: controlling playback
+
+#
+# $mpd->play( [$song] );
+#
+# Begin playing playlist at song number $song. If no argument supplied,
+# resume playing.
+#
+sub play {
+    my ($self, $number) = @_;
+    $number = '' unless defined $number;
+    $self->_send_command("play $number\n");
+}
+
+#
+# $mpd->playid( [$songid] );
+#
+# Begin playing playlist at song ID $songid. If no argument supplied,
+# resume playing.
+#
+sub playid {
+    my ($self, $number) = @_;
+    $number ||= '';
+    $self->_send_command("playid $number\n");
+}
+
+
+#
+# $mpd->pause( [$sate] );
+#
+# Pause playback. If $state is 0 then the current track is unpaused, if
+# $state is 1 then the current track is paused.
+#
+# Note that if $state is not given, pause state will be toggled.
+#
+sub pause {
+    my ($self, $state) = @_;
+    $state ||= ''; # default is to toggle
+    $self->_send_command("pause $state\n");
+}
+
+
+#
+# $mpd->stop;
+#
+# Stop playback.
+#
+sub stop {
+    my ($self) = @_;
+    $self->_send_command("stop\n");
+}
+
+
+#
+# $mpd->next;
+#
+# Play next song in playlist.
+#
+sub next {
+    my ($self) = @_;
+    $self->_send_command("next\n");
+}
+
+#
+# $mpd->prev;
+#
+# Play previous song in playlist.
+#
+sub prev {
+    my($self) = shift;
+    $self->_send_command("previous\n");
+}
+
+
+#
+# $mpd->seek( $time, [$song] );
+#
+# Seek to $time seconds in song number $song. If $song number is not specified
+# then the perl module will try and seek to $time in the current song.
+#
+sub seek {
+    my ($self, $time, $song) = @_;
+    $time ||= 0; $time = int $time;
+    $song = $self->status->song if not defined $song; # seek in current song
+    $self->_send_command( "seek $song $time\n" );
+}
+
+
+#
+# $mpd->seekid( $time, [$songid] );
+#
+# Seek to $time seconds in song ID $songid. If $songid number is not specified
+# then the perl module will try and seek to $time in the current song.
+#
+sub seekid {
+    my ($self, $time, $song) = @_;
+    $time ||= 0; $time = int $time;
+    $song = $self->status->songid if not defined $song; # seek in current song
+    $self->_send_command( "seekid $song $time\n" );
+}
+
+
+1;
+
+
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Audio::MPD - class to talk to MPD (Music Player Daemon) servers
+
+
+=head1 SYNOPSIS
+
+    use Audio::MPD;
+
+    my $mpd = Audio::MPD->new();
+    $mpd->play();
+    sleep 10;
+    $mpd->next();
+
+
+=head1 DESCRIPTION
+
+Audio::MPD gives a clear object-oriented interface for talking to and
+controlling MPD (Music Player Daemon) servers. A connection to the MPD
+server is established as soon as a new Audio::MPD object is created.
+
+Note that the module will by default connect to mpd before sending any
+command, and will disconnect after the command has been issued. This scheme
+is far from optimal, but allows us not to care about timeout disconnections.
+
+B</!\> Note that Audio::MPD is using high-level, blocking sockets. This
+means that if the mpd server is slow, or hangs for whatever reason, or
+even crash abruptly, the program will be hung forever in this sub. The
+POE::Component::Client::MPD module is way safer - you're advised to use
+it instead of Audio::MPD. Or you can try to set C<conntype> to C<$REUSE>
+(see Audio::MPD constructor for more details), but you would be then on
+your own to deal with disconnections.
+
+
+=head1 METHODS
+
+=head2 Constructor
+
+=over 4
+
+=item new( [%opts] )
+
+This is the constructor for Audio::MPD. One can specify the following
+options:
+
+=over 4
+
+=item hostname => C<$hostname>
+
+defaults to environment var MPD_HOST, then to 'localhost'. Note that
+MPD_HOST can be of the form password@host.
+
+=item port => C<$port>
+
+defaults to environment var MPD_PORT, then to 6600.
+
+=item password => $password
+
+defaults to environment var MPD_PASSWORD, then to ''.
+
+=item conntype => $type
+
+change how the connection to mpd server is handled. It can be either
+C<$REUSE> to reuse the same connection or C<$ONCE> to open a new
+connection per command (default)
+
+=back
+
+
+=back
+
+
+=head2 Controlling the server
+
+=over 4
+
+=item $mpd->ping()
+
+Sends a ping command to the mpd server.
+
+
+=item $mpd->version()
+
+Return the version number for the server we are connected to.
+
+
+=item $mpd->kill()
+
+Send a message to the MPD server telling it to shut down.
+
+
+=item $mpd->password( [$password] )
+
+Change password used to communicate with MPD server to $password.
+Empty string is assumed if $password is not supplied.
+
+
+=item $mpd->updatedb( [$path] )
+
+Force mpd to recan its collection. If $path (relative to MPD's music directory)
+is supplied, MPD will only scan it - otherwise, MPD will rescan its whole
+collection.
+
+
+=item $mpd->urlhandlers()
+
+Return an array of supported URL schemes.
+
+
+=back
+
+
+=head2 Handling volume & output
+
+=over 4
+
+=item $mpd->volume( [+][-]$volume )
+
+Sets the audio output volume percentage to absolute $volume.
+If $volume is prefixed by '+' or '-' then the volume is changed relatively
+by that value.
+
+
+=item $mpd->output_enable( $output )
+
+Enable the specified audio output. $output is the ID of the audio output.
+
+
+=item $mpd->output_disable( $output )
+
+Disable the specified audio output. $output is the ID of the audio output.
+
+=back
+
+
+=head2 Retrieving info from current state
+
+=over 4
+
+=item $mpd->stats()
+
+Return an C<Audio::MPD::Common::Stats> object with the current statistics
+of MPD. See the associated pod for more information.
+
+
+=item $mpd->status()
+
+Return an C<Audio::MPD::Common::Status> object with various information on
+current MPD server settings. Check the embedded pod for more information on
+the available accessors.
+
+
+=item $mpd->current()
+
+Return an C<Audio::MPD::Common::Item::Song> representing the song currently
+playing.
+
+
+=item $mpd->song( [$song] )
+
+Return an C<Audio::MPD::Common::Item::Song> representing the song number
+C<$song>. If C<$song> is not supplied, returns the current song.
+
+
+=item $mpd->songid( [$songid] )
+
+Return an C<Audio::MPD::Common::Item::Song> representing the song with id
+C<$songid>. If C<$songid> is not supplied, returns the current song.
+
+=back
+
+
+=head2 Altering MPD settings
+
+=over 4
+
+=item $mpd->repeat( [$repeat] )
+
+Set the repeat mode to $repeat (1 or 0). If $repeat is not specified then
+the repeat mode is toggled.
+
+
+=item $mpd->random( [$random] )
+
+Set the random mode to $random (1 or 0). If $random is not specified then
+the random mode is toggled.
+
+
+=item $mpd->fade( [$seconds] )
+
+Enable crossfading and set the duration of crossfade between songs.
+If $seconds is not specified or $seconds is 0, then crossfading is disabled.
+
+=back
+
+
+=head2 Controlling playback
+
+=over 4
+
+=item $mpd->play( [$song] )
+
+Begin playing playlist at song number $song. If no argument supplied,
+resume playing.
+
+
+=item $mpd->playid( [$songid] )
+
+Begin playing playlist at song ID $songid. If no argument supplied,
+resume playing.
+
+
+=item $mpd->pause( [$state] )
+
+Pause playback. If C<$state> is 0 then the current track is unpaused,
+if $state is 1 then the current track is paused.
+
+Note that if C<$state> is not given, pause state will be toggled.
+
+
+=item $mpd->stop()
+
+Stop playback.
+
+
+=item $mpd->next()
+
+Play next song in playlist.
+
+
+=item $mpd->prev()
+
+Play previous song in playlist.
+
+
+=item $mpd->seek( $time, [$song])
+
+Seek to $time seconds in song number $song. If $song number is not specified
+then the perl module will try and seek to $time in the current song.
+
+
+=item $mpd->seekid( $time, $songid )
+
+Seek to $time seconds in song ID $songid. If $song number is not specified
+then the perl module will try and seek to $time in the current song.
+
+=back
+
+
+=head2 Searching the collection
+
+To search the collection, use the C<collection()> accessor, returning the
+associated C<Audio::MPD::Collection> object. You will then be able to call:
+
+    $mpd->collection->random_song();
+
+See C<Audio::MPD::Collection> documentation for more details on available
+methods.
+
+
+=head2 Handling the playlist
+
+To update the playlist, use the C<playlist()> accessor, returning the
+associated C<Audio::MPD::Playlist> object. You will then be able to call:
+
+    $mpd->playlist->clear;
+
+See C<Audio::MPD::Playlist> documentation for more details on available
+methods.
+
+
+=head1 SEE ALSO
+
+You can find more information on the mpd project on its homepage at
+L<http://www.musicpd.org>, or its wiki L<http://mpd.wikia.com>.
+
+Regarding this Perl module, you can report bugs on CPAN via
+L<http://rt.cpan.org/Public/Bug/Report.html?Queue=Audio-MPD>.
+
+Audio::MPD development takes place on <audio-mpd@googlegroups.com>: feel free
+to join us. (use L<http://groups.google.com/group/audio-mpd> to sign in). Our
+subversion repository is located at L<https://svn.musicpd.org>.
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+Original code by Tue Abrahamsen C<< <tue.abrahamsen at gmail.com> >>,
+documented by Nicholas J. Humfrey C<< <njh at aelius.com> >>.
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2005 Tue Abrahamsen, all rights reserved.
+Copyright (c) 2006 Nicolas J. Humfrey, all rights reserved.
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Collection.pm b/config/mpfire/perl/Audio/MPD/Collection.pm
new file mode 100644 (file)
index 0000000..7275128
--- /dev/null
@@ -0,0 +1,594 @@
+#
+# This file is part of Audio::MPD
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Collection;
+
+use strict;
+use warnings;
+use Scalar::Util qw[ weaken ];
+
+use base qw[ Class::Accessor::Fast ];
+__PACKAGE__->mk_accessors( qw[ _mpd ] );
+
+
+#our ($VERSION) = '$Rev: 5284 $' =~ /(\d+)/;
+
+
+#--
+# Constructor
+
+#
+# my $collection = Audio::MPD::Collection->new( $mpd );
+#
+# This will create the object, holding a back-reference to the Audio::MPD
+# object itself (for communication purposes). But in order to play safe and
+# to free the memory in time, this reference is weakened.
+#
+# Note that you're not supposed to call this constructor yourself, an
+# Audio::MPD::Collection is automatically created for you during the creation
+# of an Audio::MPD object.
+#
+sub new {
+    my ($pkg, $mpd) = @_;
+
+    my $self = { _mpd => $mpd };
+    weaken( $self->{_mpd} );
+    bless $self, $pkg;
+    return $self;
+}
+
+
+#--
+# Public methods
+
+# -- Collection: retrieving songs & directories
+
+#
+# my @items = $collection->all_items( [$path] );
+#
+# Return *all* AMC::Items (both songs & directories) currently known
+# by mpd.
+#
+# If $path is supplied (relative to mpd root), restrict the retrieval to
+# songs and dirs in this directory.
+#
+sub all_items {
+    my ($self, $path) = @_;
+    $path ||= '';
+    $path =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[listallinfo "$path"\n] );
+}
+
+
+#
+# my @items = $collection->all_items_simple( [$path] );
+#
+# Return *all* AMC::Items (both songs & directories) currently known
+# by mpd.
+#
+# If $path is supplied (relative to mpd root), restrict the retrieval to
+# songs and dirs in this directory.
+#
+# /!\ Warning: the AMC::Item::Song objects will only have their tag
+# file filled. Any other tag will be empty, so don't use this sub for any
+# other thing than a quick scan!
+#
+sub all_items_simple {
+    my ($self, $path) = @_;
+    $path ||= '';
+    $path =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[listall "$path"\n] );
+}
+
+
+#
+# my @items = $collection->items_in_dir( [$path] );
+#
+# Return the items in the given $path. If no $path supplied, do it on mpd's
+# root directory.
+#
+# Note that this sub does not work recusrively on all directories.
+#
+sub items_in_dir {
+    my ($self, $path) = @_;
+    $path ||= '';
+    $path =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[lsinfo "$path"\n] );
+}
+
+
+
+# -- Collection: retrieving the whole collection
+
+#
+# my @songs = $collection->all_songs( [$path] );
+#
+# Return *all* AMC::Item::Songs currently known by mpd.
+#
+# If $path is supplied (relative to mpd root), restrict the retrieval to
+# songs and dirs in this directory.
+#
+sub all_songs {
+    my ($self, $path) = @_;
+    return grep { $_->isa('Audio::MPD::Common::Item::Song') } $self->all_items($path);
+}
+
+
+#
+# my @albums = $collection->all_albums;
+#
+# Return the list of all albums (strings) currently known by mpd.
+#
+sub all_albums {
+    my ($self) = @_;
+    return $self->_mpd->_cooked_command_strip_first_field( "list album\n" );
+}
+
+
+#
+# my @artists = $collection->all_artists;
+#
+# Return the list of all artists (strings) currently known by mpd.
+#
+sub all_artists {
+    my ($self) = @_;
+    return $self->_mpd->_cooked_command_strip_first_field( "list artist\n" );
+}
+
+
+#
+# my @titles = $collection->all_titles;
+#
+# Return the list of all titles (strings) currently known by mpd.
+#
+sub all_titles {
+    my ($self) = @_;
+    return $self->_mpd->_cooked_command_strip_first_field( "list title\n" );
+}
+
+
+#
+# my @genre = $collection->all_genre;
+#
+# Return the list of all genres (strings) currently known by mpd.
+#
+sub all_genre {
+    my ($self) = @_;
+    return $self->_mpd->_cooked_command_strip_first_field( "list genre\n" );
+}
+
+
+#
+# my @yers = $collection->all_years;
+#
+# Return the list of all years (strings) currently known by mpd.
+#
+sub all_years {
+    my ($self) = @_;
+    return $self->_mpd->_cooked_command_strip_first_field( "list date\n" );
+}
+
+
+#
+# my @pathes = $collection->all_pathes;
+#
+# Return the list of all pathes (strings) currently known by mpd.
+#
+sub all_pathes {
+    my ($self) = @_;
+    return $self->_mpd->_cooked_command_strip_first_field( "list filename\n" );
+}
+
+
+#
+# my @items = $collection->all_playlists;
+#
+# Return the list of playlists (strings) currently known by mpd.
+#
+sub all_playlists {
+    my ($self) = @_;
+
+    return
+        map { /^playlist: (.*)$/ ? ($1) : () }
+        $self->_mpd->_send_command( "lsinfo\n" );
+}
+
+
+
+# -- Collection: picking songs
+
+#
+# my $song = $collection->song( $path );
+#
+# Return the AMC::Item::Song which correspond to $path.
+#
+sub song {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    my ($item) = $self->_mpd->_cooked_command_as_items( qq[find filename "$what"\n] );
+    return $item;
+}
+
+
+#
+# my $song = $collection->songs_with_filename_partial( $path );
+#
+# Return the AMC::Item::Songs containing $string in their path.
+#
+sub songs_with_filename_partial {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[search filename "$what"\n] );
+}
+
+
+# -- Collection: songs, albums & artists relations
+
+#
+# my @albums = $collection->albums_by_artist($artist);
+#
+# Return all albums (strings) performed by $artist or where $artist
+# participated.
+#
+sub albums_by_artist {
+    my ($self, $artist) = @_;
+    $artist =~ s/"/\\"/g;
+    return $self->_mpd->_cooked_command_strip_first_field( qq[list album "$artist"\n] );
+}
+
+
+#
+# my @songs = $collection->songs_by_artist( $genre );
+#
+# Return all AMC::Item::Songs performed in $genre.
+#
+
+sub songs_by_genre {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[find genre "$what"\n] );
+}
+
+
+sub filenames_by_artist {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_filename( qq[find artist "$what"\n] );
+}
+
+
+sub filenames_by_year {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_filename( qq[find date "$what"\n] );
+}
+
+sub filenames_by_genre {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_filename( qq[find genre "$what"\n] );
+}
+
+
+sub filenames_by_album {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_filename( qq[find album "$what"\n] );
+}
+
+
+#
+# my @songs = $collection->songs_by_artist_partial( $string );
+#
+# Return all AMC::Item::Songs performed by an artist with $string
+# in her name.
+#
+sub songs_by_artist_partial {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[search artist "$what"\n] );
+}
+
+
+#
+# my @songs = $collection->songs_from_album( $album );
+#
+# Return all AMC::Item::Songs appearing in $album.
+#
+sub songs_from_album {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[find album "$what"\n] );
+}
+
+
+#
+# my @songs = $collection->songs_from_album_partial( $string );
+#
+# Return all AMC::Item::Songs appearing in album containing $string.
+#
+sub songs_from_album_partial {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[search album "$what"\n] );
+}
+
+
+#
+# my @songs = $collection->songs_with_title( $title );
+#
+# Return all AMC::Item::Songs which title is exactly $title.
+#
+sub songs_with_title {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[find title "$what"\n] );
+}
+
+
+#
+# my @songs = $collection->songs_with_title_partial( $string );
+#
+# Return all AMC::Item::Songs where $string is part of the title.
+#
+sub songs_with_title_partial {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_items( qq[search title "$what"\n] );
+}
+
+
+# my @songs = $collection->songs_with_title_partial_filename( $string );
+#
+# Return all AMC::Item::Songs where $string is part of the title.
+#
+sub songs_with_title_partial_filename {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+
+    return $self->_mpd->_cooked_command_as_filename( qq[search title "$what"\n] );
+}
+
+# my @songs = $collection->songs_with_artist_partial_filename( $string );
+#
+# Return all AMC::Item::Songs where $string is part of the artist.
+#
+sub songs_with_artist_partial_filename {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_filename( qq[search artist "$what"\n] );
+}
+
+
+# my @songs = $collection->songs_with_album_partial_filename( $string );
+#
+# Return all AMC::Item::Songs where $string is part of the album.
+#
+sub songs_with_album_partial_filename {
+    my ($self, $what) = @_;
+    $what =~ s/"/\\"/g;
+
+    return $self->_mpd->_cooked_command_as_filename( qq[search album "$what"\n] );
+}
+
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Audio::MPD::Collection - an object to query MPD's collection
+
+
+=head1 SYNOPSIS
+
+    my $song = $mpd->collection->random_song;
+
+
+=head1 DESCRIPTION
+
+C<Audio::MPD::Collection> is a class meant to access & query MPD's
+collection. You will be able to use those high-level methods instead
+of using the low-level methods provided by mpd itself.
+
+
+=head1 PUBLIC METHODS
+
+=head2 Constructor
+
+=over 4
+
+=item new( $mpd )
+
+This will create the object, holding a back-reference to the C<Audio::MPD>
+object itself (for communication purposes). But in order to play safe and
+to free the memory in time, this reference is weakened.
+
+Note that you're not supposed to call this constructor yourself, an
+C<Audio::MPD::Collection> is automatically created for you during the creation
+of an C<Audio::MPD> object.
+
+=back
+
+
+=head2 Retrieving songs & directories
+
+=over 4
+
+=item $coll->all_items( [$path] )
+
+Return B<all> C<Audio::MPD::Common::Item>s (both songs & directories)
+currently known by mpd.
+
+If C<$path> is supplied (relative to mpd root), restrict the retrieval to
+songs and dirs in this directory.
+
+
+=item $coll->all_items_simple( [$path] )
+
+Return B<all> C<Audio::MPD::Common::Item>s (both songs & directories)
+currently known by mpd.
+
+If C<$path> is supplied (relative to mpd root), restrict the retrieval to
+songs and dirs in this directory.
+
+B</!\ Warning>: the C<Audio::MPD::Common::Item::Song> objects will only have
+their tag file filled. Any other tag will be empty, so don't use this sub for
+any other thing than a quick scan!
+
+
+=item $coll->items_in_dir( [$path] )
+
+Return the items in the given C<$path>. If no C<$path> supplied, do it on
+mpd's root directory.
+
+Note that this sub does not work recusrively on all directories.
+
+
+=back
+
+
+=head2 Retrieving the whole collection
+
+=over 4
+
+=item $coll->all_songs( [$path] )
+
+Return B<all> C<Audio::MPD::Common::Item::Song>s currently known by mpd.
+
+If C<$path> is supplied (relative to mpd root), restrict the retrieval to
+songs and dirs in this directory.
+
+
+=item $coll->all_albums()
+
+Return the list of all albums (strings) currently known by mpd.
+
+
+=item $coll->all_artists()
+
+Return the list of all artists (strings) currently known by mpd.
+
+
+=item $coll->all_titles()
+
+Return the list of all song titles (strings) currently known by mpd.
+
+
+=item $coll->all_pathes()
+
+Return the list of all pathes (strings) currently known by mpd.
+
+
+=item $coll->all_playlists()
+
+Return the list of all playlists (strings) currently known by mpd.
+
+
+=back
+
+
+=head2 Picking a song
+
+=over 4
+
+=item $coll->song( $path )
+
+Return the C<Audio::MPD::Common::Item::Song> which correspond to C<$path>.
+
+
+=item $coll->songs_with_filename_partial( $path )
+
+Return the C<Audio::MPD::Common::Item::Song>s containing $string in their path.
+
+
+=back
+
+
+=head2 Songs, albums & artists relations
+
+=over 4
+
+=item $coll->albums_by_artist( $artist )
+
+Return all albums (strings) performed by C<$artist> or where C<$artist>
+participated.
+
+
+=item $coll->songs_by_artist( $artist )
+
+Return all C<Audio::MPD::Common::Item::Song>s performed by C<$artist>.
+
+
+=item $coll->songs_by_artist_partial( $string )
+
+Return all C<Audio::MPD::Common::Item::Song>s performed by an artist with
+C<$string> in her name.
+
+
+=item $coll->songs_from_album( $album )
+
+Return all C<Audio::MPD::Common::Item::Song>s appearing in C<$album>.
+
+
+=item $coll->songs_from_album_partial( $string )
+
+Return all C<Audio::MPD::Common::Item::Song>s appearing in album containing C<$string>.
+
+
+=item $coll->songs_with_title( $title )
+
+Return all C<Audio::MPD::Common::Item::Song>s which title is exactly C<$title>.
+
+
+=item $coll->songs_with_title_partial( $string )
+
+Return all C<Audio::MPD::Common::Item::Song>s where C<$string> is part of the title.
+
+
+=back
+
+
+=head1 SEE ALSO
+
+L<Audio::MPD>
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Common.pm b/config/mpfire/perl/Audio/MPD/Common.pm
new file mode 100644 (file)
index 0000000..07de83c
--- /dev/null
@@ -0,0 +1,88 @@
+#
+# This file is part of Audio::MPD::Common
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Common;
+
+use warnings;
+use strict;
+our $VERSION = '0.1.2';
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Audio::MPD::Common - a bunch of common helper classes for mpd
+
+
+=head1 DESCRIPTION
+
+Depending on whether you're using a POE-aware environment or not, people
+wanting to tinker with mpd (Music Player Daemon) will use either
+L<POE::Component::Client::MPD> or L<Audio::MPD>.
+
+But even if the run-cores of those two modules differ completely, they
+are using the exact same common classes to represent the various mpd
+states and information.
+
+Therefore, those common classes have been outsourced to
+L<Audio::MPD::Common>.
+
+This module does not export any methods, but the dist provides the
+following classes that you can query with perldoc:
+
+=over 4
+
+=item o L<Audio::MPD::Common::Item>
+
+=item o L<Audio::MPD::Common::Item::Directory>
+
+=item o L<Audio::MPD::Common::Item::Playlist>
+
+=item o L<Audio::MPD::Common::Item::Song>
+
+=item o L<Audio::MPD::Common::Stats>
+
+=item o L<Audio::MPD::Common::Status>
+
+=item o L<Audio::MPD::Common::Time>
+
+=back
+
+
+Note that those modules should not be of any use outside the two mpd
+modules afore-mentioned.
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Audio::MPD>
+
+=item L<POE::Component::Client::MPD>
+
+=back
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Common/Item.pm b/config/mpfire/perl/Audio/MPD/Common/Item.pm
new file mode 100644 (file)
index 0000000..e1d4fa8
--- /dev/null
@@ -0,0 +1,100 @@
+#
+# This file is part of Audio::MPD::Common
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Common::Item;
+
+use strict;
+use warnings;
+use Audio::MPD::Common::Item::Directory;
+use Audio::MPD::Common::Item::Playlist;
+use Audio::MPD::Common::Item::Song;
+
+#our ($VERSION) = '$Rev: 5645 $' =~ /(\d+)/;
+
+#
+# constructor.
+#
+sub new {
+    my ($pkg, %params) = @_;
+
+    # transform keys in lowercase.
+    my %lowcase;
+    @lowcase{ keys %params } = values %params;
+
+    return Audio::MPD::Common::Item::Song->new(\%lowcase)      if exists $params{file};
+    return Audio::MPD::Common::Item::Directory->new(\%lowcase) if exists $params{directory};
+    return Audio::MPD::Common::Item::Playlist->new(\%lowcase)  if exists $params{playlist};
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Audio::MPD::Common::Item - a generic collection item
+
+
+=head1 SYNOPSIS
+
+    my $item = Audio::MPD::Common::Item->new( %params );
+
+
+=head1 DESCRIPTION
+
+C<Audio::MPD::Common::Item> is a virtual class representing a generic
+item of mpd's collection. It can be either a song, a directory or a playlist.
+
+Depending on the params given to C<new>, it will create and return an
+C<Audio::MPD::Common::Item::Song>, an C<Audio::MPD::Common::Item::Directory>
+or an C<Audio::MPD::Common::Playlist> object. Currently, the
+discrimination is done on the existence of the C<file> key of C<%params>.
+
+
+=head1 PUBLIC METHODS
+
+Note that the only sub worth it in this class is the constructor:
+
+=over 4
+
+=item new( key => val [, key => val [, ...] ] )
+
+Create and return either an C<Audio::MPD::Common::Item::Song>, an
+C<Audio::MPD::Common::Item::Directory> or an C<Audio::MPD::Common::Playlist>
+object, depending on the existence of a key C<file>, C<directory> or
+C<playlist> (respectively).
+
+=back
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Audio::MPD>
+
+=item L<POE::Component::Client::MPD>
+
+=back
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Common/Item/Directory.pm b/config/mpfire/perl/Audio/MPD/Common/Item/Directory.pm
new file mode 100644 (file)
index 0000000..cd9076d
--- /dev/null
@@ -0,0 +1,72 @@
+#
+# This file is part of Audio::MPD::Common
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Common::Item::Directory;
+
+use strict;
+use warnings;
+
+use base qw[ Class::Accessor::Fast Audio::MPD::Common::Item ];
+__PACKAGE__->mk_accessors( qw[ directory ] );
+
+#our ($VERSION) = '$Rev: 5645 $' =~ /(\d+)/;
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Audio::MPD::Common::Item::Directory - a directory object
+
+
+=head1 SYNOPSIS
+
+    print $item->directory . "\n";
+
+
+=head1 DESCRIPTION
+
+C<Audio::MPD::Common::Item::Directory> is more a placeholder for a
+hash ref with one pre-defined key, namely the directory name.
+
+
+=head1 PUBLIC METHODS
+
+This module only has a C<new()> constructor, which should only be called by
+C<Audio::MPD::Common::Item>'s constructor.
+
+The only other public method is an accessor: directory().
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Audio::MPD>
+
+=item L<POE::Component::Client::MPD>
+
+=back
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Common/Item/Playlist.pm b/config/mpfire/perl/Audio/MPD/Common/Item/Playlist.pm
new file mode 100644 (file)
index 0000000..bfeda98
--- /dev/null
@@ -0,0 +1,72 @@
+#
+# This file is part of Audio::MPD::Common
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Common::Item::Playlist;
+
+use strict;
+use warnings;
+
+use base qw[ Class::Accessor::Fast Audio::MPD::Common::Item ];
+__PACKAGE__->mk_accessors( qw[ playlist ] );
+
+#our ($VERSION) = '$Rev: 5645 $' =~ /(\d+)/;
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Audio::MPD::Common::Item::Playlist - a playlist object
+
+
+=head1 SYNOPSIS
+
+    print $item->playlist . "\n";
+
+
+=head1 DESCRIPTION
+
+C<Audio::MPD::Common::Item::Playlist> is more a placeholder for a hash ref
+with one pre-defined key, namely the playlist name.
+
+
+=head1 PUBLIC METHODS
+
+This module only has a C<new()> constructor, which should only be called by
+C<Audio::MPD::Common::Item>'s constructor.
+
+The only other public method is an accessor: playlist().
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Audio::MPD>
+
+=item L<POE::Component::Client::MPD>
+
+=back
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Common/Item/Song.pm b/config/mpfire/perl/Audio/MPD/Common/Item/Song.pm
new file mode 100644 (file)
index 0000000..4ce8d6d
--- /dev/null
@@ -0,0 +1,133 @@
+#
+# This file is part of Audio::MPD::Common
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Common::Item::Song;
+
+use strict;
+use warnings;
+
+use overload '""' => \&as_string;
+use Readonly;
+
+use base qw[ Class::Accessor::Fast Audio::MPD::Common::Item ];
+__PACKAGE__->mk_accessors( qw[ Album Artist file id pos Title Track time ] );
+
+#our ($VERSION) = '$Rev: 5645 $' =~ /(\d+)/;
+
+Readonly my $SEP => ' = ';
+
+
+#
+# my $str = $song->as_string;
+#
+# Return a string representing $song. This string will be;
+#  - either "Album = Track = Artist = Title"
+#  - or     "Artist = Title"
+#  - or     "Title"
+#  - or     "file"
+# (in this order), depending on the existing tags of the song. The last
+# possibility always exist of course, since it's a path.
+#
+sub as_string {
+    my ($self) = @_;
+
+    return $self->file unless defined $self->Title;
+    my $str = $self->Title;
+    return $str unless defined $self->Artist;
+    $str = $self->Artist . $SEP . $str;
+    return $str unless defined $self->Album && defined $self->Track;
+    return join $SEP,
+        $self->Album,
+        $self->Track,
+        $str;
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Audio::MPD::Common::Item::Song - a song object with some audio tags
+
+
+=head1 DESCRIPTION
+
+C<Audio::MPD::Common::Item::Song> is more a placeholder for a
+hash ref with some pre-defined keys, namely some audio tags.
+
+
+=head1 PUBLIC METHODS
+
+This module has a C<new()> constructor, which should only be called by
+C<Audio::MPD::Common::Item>'s constructor.
+
+The only other public methods are the accessors - see below.
+
+
+=head2 Accessors
+
+The following methods are the accessors to their respective named fields:
+C<Album()>, C<Artist()>, C<file()>, C<id>, C<pos>, C<Title()>, CTTrack()>,
+C<time()>. You can call them either with no arg to get the value, or with
+an arg to replace the current value.
+
+
+=head2 Methods
+
+
+=over 4
+
+=item $song->as_string()
+
+Return a string representing $song. This string will be:
+
+=over 4
+
+=item either "Album = Track = Artist = Title"
+
+=item or "Artist = Title"
+
+=item or "Title"
+
+=item or "file"
+
+=back
+
+(in this order), depending on the existing tags of the song. The last
+possibility always exist of course, since it's a path.
+
+=back
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Audio::MPD>
+
+=item L<POE::Component::Client::MPD>
+
+=back
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Common/Stats.pm b/config/mpfire/perl/Audio/MPD/Common/Stats.pm
new file mode 100644 (file)
index 0000000..0674907
--- /dev/null
@@ -0,0 +1,135 @@
+#
+# This file is part of Audio::MPD::Common
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Common::Stats;
+
+use warnings;
+use strict;
+
+use base qw[ Class::Accessor::Fast ];
+__PACKAGE__->mk_accessors
+    ( qw[ artists albums songs uptime playtime db_playtime db_update ] );
+
+#our ($VERSION) = '$Rev$' =~ /(\d+)/;
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Audio::MPD::Common::Stats - class representing MPD stats
+
+
+=head1 SYNOPSIS
+
+    print $stats->artists;
+
+
+=head1 DESCRIPTION
+
+The MPD server maintains some general information. Those information can be
+queried with the mpd modules. Some of those information are served to you as
+an C<Audio::MPD::Common::Status> object.
+
+Note that an C<Audio::MPD::Common::Stats> object does B<not> update itself
+regularly, and thus should be used immediately.
+
+
+=head1 METHODS
+
+=head2 Constructor
+
+=over 4
+
+=item new( %kv )
+
+The C<new()> method is the constructor for the C<Audio::MPD::Common::Stats>
+class.
+
+Note: one should B<never> ever instantiate an C<Audio::MPD::Common::Stats>
+object directly - use the mpd modules instead.
+
+=back
+
+
+=head2 Accessors
+
+Once created, one can access to the following members of the object:
+
+=over 4
+
+=item $stats->artists()
+
+Number of artists in the music database.
+
+
+=item $stats->albums()
+
+Number of albums in the music database.
+
+
+=item $stats->songs()
+
+Number of songs in the music database.
+
+
+=item $stats->uptime()
+
+Daemon uptime (time since last startup) in seconds.
+
+
+=item $stats->playtime()
+
+Time length of music played.
+
+
+=item $stats->db_playtime()
+
+Sum of all song times in the music database.
+
+
+=item $stats->db_update()
+
+Last database update in UNIX time.
+
+
+=back
+
+
+Please note that those accessors are read-only: changing a value will B<not>
+change the current settings of MPD server. Use the mpd modules to alter the
+settings.
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Audio::MPD>
+
+=item L<POE::Component::Client::MPD>
+
+=back
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Common/Status.pm b/config/mpfire/perl/Audio/MPD/Common/Status.pm
new file mode 100644 (file)
index 0000000..f9c98e2
--- /dev/null
@@ -0,0 +1,192 @@
+#
+# This file is part of Audio::MPD::Common
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Common::Status;
+
+use warnings;
+use strict;
+
+use Audio::MPD::Common::Time;
+
+use base qw[ Class::Accessor::Fast ];
+__PACKAGE__->mk_accessors
+    ( qw[ audio bitrate error playlist playlistlength random
+          repeat song songid state time volume updating_db xfade ] );
+
+#our ($VERSION) = '$Rev: 5865 $' =~ /(\d+)/;
+
+
+#--
+# Constructor
+
+#
+# my $status = Audio::MPD::Common::Status->new( \%kv )
+#
+# The constructor for the class Audio::MPD::Common::Status. %kv is
+# a cooked output of what MPD server returns to the status command.
+#
+sub new {
+    my ($class, $kv) = @_;
+    my %kv = %$kv;
+    $kv{time} = Audio::MPD::Common::Time->new( delete $kv{time} );
+    bless \%kv, $class;
+    return \%kv;
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Audio::MPD::Common::Status - class representing MPD status
+
+
+=head1 SYNOPSIS
+
+    print $status->bitrate;
+
+
+=head1 DESCRIPTION
+
+The MPD server maintains some information on its current state. Those
+information can be queried with mpd modules. Some of those information
+are served to you as an C<Audio::MPD::Common::Status> object.
+
+Note that an C<Audio::MPD::Common::Status> object does B<not> update
+itself regularly, and thus should be used immediately.
+
+
+=head1 METHODS
+
+=head2 Constructor
+
+=over 4
+
+=item new( \%kv )
+
+The C<new()> method is the constructor for the C<Audio::MPD::Common::Status>
+class.
+
+Note: one should B<never> ever instantiate an C<Audio::MPD::Common::Status>
+object directly - use the mpd modules instead.
+
+=back
+
+
+=head2 Accessors
+
+Once created, one can access to the following members of the object:
+
+=over 4
+
+=item $status->audio()
+
+A string with the sample rate of the song currently playing, number of bits
+of the output and number of channels (2 for stereo) - separated by a colon.
+
+
+=item $status->bitrate()
+
+The instantaneous bitrate in kbps.
+
+
+=item $status->error()
+
+May appear in special error cases, such as when disabling output.
+
+
+=item $status->playlist()
+
+The playlist version number, that changes every time the playlist is updated.
+
+
+=item $status->playlistlength()
+
+The number of songs in the playlist.
+
+
+=item $status->random()
+
+Whether the playlist is read randomly or not.
+
+
+=item $status->repeat()
+
+Whether the song is repeated or not.
+
+
+=item $status->song()
+
+The offset of the song currently played in the playlist.
+
+
+=item $status->songid()
+
+The song id (MPD id) of the song currently played.
+
+
+=item $status->state()
+
+The state of MPD server. Either C<play>, C<stop> or C<pause>.
+
+
+=item $status->time()
+
+An C<Audio::MPD::Common::Time> object, representing the time elapsed /
+remainging and total. See the associated pod for more details.
+
+
+=item $status->updating_db()
+
+An integer, representing the current update job.
+
+
+=item $status->volume()
+
+The current MPD volume - an integer between 0 and 100.
+
+
+=item $status->xfade()
+
+The crossfade in seconds.
+
+
+=back
+
+Please note that those accessors are read-only: changing a value will B<not>
+change the current settings of MPD server. Use the mpd modules to alter the
+settings.
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Audio::MPD>
+
+=item L<POE::Component::Client::MPD>
+
+=back
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Common/Time.pm b/config/mpfire/perl/Audio/MPD/Common/Time.pm
new file mode 100644 (file)
index 0000000..77b6c7d
--- /dev/null
@@ -0,0 +1,186 @@
+#
+# This file is part of Audio::MPD::Common
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Common::Time;
+
+use warnings;
+use strict;
+
+use base qw[ Class::Accessor::Fast ];
+__PACKAGE__->mk_accessors
+    ( qw[ percent sofar left total
+          sofar_secs sofar_mins seconds_sofar
+          total_secs total_mins seconds_total
+          left_secs  left_mins  seconds_left
+        ] );
+
+#our ($VERSION) = '$Rev$' =~ /(\d+)/;
+
+
+#--
+# Constructor
+
+#
+# my $status = Audio::MPD::Common::Time->new( $time )
+#
+# The constructor for the class Audio::MPD::Common::Time. $time is
+# the time value (on the "time" line) of what the output MPD server
+# returns to the status command.
+#
+sub new {
+    my ($class, $time) = @_;
+    $time ||= '0:0';
+    my ($seconds_sofar, $seconds_total) = split /:/, $time;
+    my $seconds_left = $seconds_total - $seconds_sofar;
+    my $percent      = $seconds_total ? 100*$seconds_sofar/$seconds_total : 0;
+
+    # Parse the time so far
+    my $sofar_mins = int( $seconds_sofar / 60 );
+    my $sofar_secs = $seconds_sofar % 60;
+    my $sofar = sprintf "%d:%02d", $sofar_mins, $sofar_secs;
+
+    # Parse the total time
+    my $total_mins = int( $seconds_total / 60 );
+    my $total_secs = $seconds_total % 60;
+    my $total = sprintf "%d:%02d", $total_mins, $total_secs;
+
+    # Parse the time left
+    my $left_mins = int( $seconds_left / 60 );
+    my $left_secs = $seconds_left % 60;
+    my $left = sprintf "%d:%02d", $left_mins, $left_secs;
+
+
+    # create object
+    my $self = {
+        # time elapsed in seconds
+        seconds_sofar => $seconds_sofar,
+        seconds_left  => $seconds_left,
+        seconds_total => $seconds_total,
+
+        # cooked values
+        sofar      => $sofar,
+        left       => $left,
+        total      => $total,
+        percent    => sprintf("%.1f", $percent), # 1 decimal
+
+        # details
+        sofar_secs => $sofar_secs,
+        sofar_mins => $sofar_mins,
+        total_secs => $total_secs,
+        total_mins => $total_mins,
+        left_secs  => $left_secs,
+        left_mins  => $left_mins,
+    };
+    bless $self, $class;
+    return $self;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Audio::MPD::Common::Time - class representing time of current song
+
+
+=head1 SYNOPSIS
+
+    my $time = $status->time;
+    print $time->sofar;
+
+
+=head1 DESCRIPTION
+
+C<Audio::MPD::Common::Status> returns some time information with the C<time()>
+accessor. This information relates to the elapsed time of the current song,
+as well as the remaining and total time. This information is encapsulated
+in an C<Audio::MPD::Common::Time> object.
+
+Note that an C<Audio::MPD::Common::Time> object does B<not> update itself
+regularly, and thus should be used immediately.
+
+
+=head1 METHODS
+
+=head2 Constructor
+
+=over 4
+
+=item new( $time )
+
+The C<new()> method is the constructor for the C<Audio::MPD::Common::Time>
+class.
+
+Note: one should B<never> ever instantiate an C<Audio::MPD::Common::Time>
+object directly - use the mpd modules instead.
+
+=back
+
+
+=head2 Accessors
+
+Once created, one can access the following members of the object:
+
+=over 4
+
+=item cooked values:
+
+The C<sofar()>, C<left()> and C<total()> methods return the according values
+under the form C<minutes:seconds>. Note the existence of a C<percent()>
+method returning a percentage complete. (one decimal)
+
+
+=item values in seconds:
+
+The C<seconds_sofar()>, C<seconds_left()> and C<seconds_total()> return the
+according values in seconds.
+
+
+=item detailled values:
+
+If you want to cook your own value, then the following methods can help:
+C<sofar_secs()> and C<sofar_mins()> return the seconds and minutes elapsed.
+Same for C<left_secs()> and C<left_mins()> (time remaining), C<total_secs()>
+and C<total_mins()>. (total song length)
+
+
+=back
+
+
+Please note that those accessors are read-only: changing a value will B<not>
+change the current settings of MPD server. Use the mpd modules to alter the
+settings.
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Audio::MPD>
+
+=item L<POE::Component::Client::MPD>
+
+=back
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Playlist.pm b/config/mpfire/perl/Audio/MPD/Playlist.pm
new file mode 100644 (file)
index 0000000..b59499d
--- /dev/null
@@ -0,0 +1,427 @@
+#
+# This file is part of Audio::MPD
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Playlist;
+
+use strict;
+use warnings;
+use Scalar::Util qw[ weaken ];
+
+use base qw[ Class::Accessor::Fast ];
+__PACKAGE__->mk_accessors( qw[ _mpd ] );
+
+
+#our ($VERSION) = '$Rev$' =~ /(\d+)/;
+
+
+#--
+# Constructor
+
+#
+# my $collection = Audio::MPD::Playlist->new( $mpd );
+#
+# This will create the object, holding a back-reference to the Audio::MPD
+# object itself (for communication purposes). But in order to play safe and
+# to free the memory in time, this reference is weakened.
+#
+# Note that you're not supposed to call this constructor yourself, an
+# Audio::MPD::Playlist is automatically created for you during the creation
+# of an Audio::MPD object.
+#
+sub new {
+    my ($pkg, $mpd) = @_;
+
+    my $self = { _mpd => $mpd };
+    weaken( $self->{_mpd} );
+    bless $self, $pkg;
+    return $self;
+}
+
+
+#--
+# Public methods
+
+# -- Playlist: retrieving information
+
+#
+# my @items = $pl->as_items;
+#
+# Return an array of AMC::Item::Songs, one for each of the
+# songs in the current playlist.
+#
+sub as_items {
+    my ($self) = @_;
+
+    my @list = $self->_mpd->_cooked_command_as_items("playlistinfo\n");
+    return @list;
+}
+
+
+#
+# my @items = $pl->items_changed_since( $plversion );
+#
+# Return a list with all the songs (as API::Song objects) added to
+# the playlist since playlist $plversion.
+#
+sub items_changed_since {
+    my ($self, $plid) = @_;
+    return $self->_mpd->_cooked_command_as_items("plchanges $plid\n");
+}
+
+
+
+# -- Playlist: adding / removing songs
+
+#
+# $pl->add( $path [, $path [...] ] );
+#
+# Add the songs identified by $path (relative to MPD's music directory) to
+# the current playlist. No return value.
+#
+sub add {
+    my ($self, @pathes) = @_;
+    my $command =
+          "command_list_begin\n"
+        . join( '', map { s/"/\\"/g; qq[add "$_"\n] } @pathes )
+        . "command_list_end\n";
+    $self->_mpd->_send_command( $command );
+}
+
+
+#
+# $pl->delete( $song [, $song [...] ] );
+#
+# Remove song number $song (starting from 0) from the current playlist. No
+# return value.
+#
+sub delete {
+    my ($self, @songs) = @_;
+    my $command =
+          "command_list_begin\n"
+        . join( '', map { s/"/\\"/g; "delete $_\n" } @songs )
+        . "command_list_end\n";
+    $self->_mpd->_send_command( $command );
+}
+
+
+#
+# $pl->deleteid( $songid [, $songid [...] ]);
+#
+# Remove the specified $songid (as assigned by mpd when inserted in playlist)
+# from the current playlist. No return value.
+#
+sub deleteid {
+    my ($self, @songs) = @_;
+    my $command =
+          "command_list_begin\n"
+        . join( '', map { "deleteid $_\n" } @songs )
+        . "command_list_end\n";
+    $self->_mpd->_send_command( $command );
+}
+
+
+#
+# $pl->clear;
+#
+# Remove all the songs from the current playlist. No return value.
+#
+sub clear {
+    my ($self) = @_;
+    $self->_mpd->_send_command("clear\n");
+}
+
+
+#
+# $pl->crop;
+#
+#  Remove all of the songs from the current playlist *except* the current one.
+#
+sub crop {
+    my ($self) = @_;
+
+    my $status = $self->_mpd->status;
+    my $cur = $status->song;
+    my $len = $status->playlistlength - 1;
+
+    my $command =
+          "command_list_begin\n"
+        . join( '', map { $_  != $cur ? "delete $_\n" : '' } reverse 0..$len )
+        . "command_list_end\n";
+    $self->_mpd->_send_command( $command );
+}
+
+
+# -- Playlist: changing playlist order
+
+#
+# $pl->shuffle();
+#
+# Shuffle the current playlist. No return value.
+#
+sub shuffle {
+    my ($self) = @_;
+    $self->_mpd->_send_command("shuffle\n");
+}
+
+
+#
+# $pl->swap( $song1, $song2 );
+#
+# Swap positions of song number $song1 and $song2 in the current playlist.
+# No return value.
+#
+sub swap {
+    my ($self, $from, $to) = @_;
+    $self->_mpd->_send_command("swap $from $to\n");
+}
+
+
+#
+# $pl->swapid( $songid1, $songid2 );
+#
+# Swap the postions of song ID $songid1 with song ID $songid2 in the
+# current playlist. No return value.
+#
+sub swapid {
+    my ($self, $from, $to) = @_;
+    $self->_mpd->_send_command("swapid $from $to\n");
+}
+
+
+#
+# $pl->move( $song, $newpos );
+#
+# Move song number $song to the position $newpos. No return value.
+#
+sub move {
+    my ($self, $song, $pos) = @_;
+    $self->_mpd->_send_command("move $song $pos\n");
+}
+
+
+#
+# $pl->moveid( $songid, $newpos );
+#
+# Move song ID $songid to the position $newpos. No return value.
+#
+sub moveid {
+    my ($self, $song, $pos) = @_;
+    $self->_mpd->_send_command("moveid $song $pos\n");
+}
+
+
+# -- Playlist: managing playlists
+
+#
+# $pl->load( $playlist );
+#
+# Load list of songs from specified $playlist file. No return value.
+#
+sub load {
+    my ($self, $playlist) = @_;
+    $self->_mpd->_send_command( qq[load "$playlist"\n] );
+}
+
+
+#
+# $pl->save( $playlist );
+#
+# Save the current playlist to a file called $playlist in MPD's playlist
+# directory. No return value.
+#
+sub save {
+    my ($self, $playlist) = @_;
+    $self->_mpd->_send_command( qq[save "$playlist"\n] );
+}
+
+
+#
+# $pl->rm( $playlist )
+#
+# Delete playlist named $playlist from MPD's playlist directory. No
+# return value.
+#
+sub rm {
+    my ($self, $playlist) = @_;
+    $self->_mpd->_send_command( qq[rm "$playlist"\n] );
+}
+
+
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Audio::MPD::Playlist - an object to mess MPD's playlist
+
+
+=head1 SYNOPSIS
+
+    my $song = $mpd->playlist->randomize;
+
+
+=head1 DESCRIPTION
+
+C<Audio::MPD::Playlist> is a class meant to access & update MPD's
+playlist.
+
+
+=head1 PUBLIC METHODS
+
+=head2 Constructor
+
+=over 4
+
+=item new( $mpd )
+
+This will create the object, holding a back-reference to the C<Audio::MPD>
+object itself (for communication purposes). But in order to play safe and
+to free the memory in time, this reference is weakened.
+
+Note that you're not supposed to call this constructor yourself, an
+C<Audio::MPD::Playlist> is automatically created for you during the creation
+of an C<Audio::MPD> object.
+
+=back
+
+
+=head2 Retrieving information
+
+=over 4
+
+=item $pl->as_items()
+
+Return an array of C<Audio::MPD::Common::Item::Song>s, one for each of the
+songs in the current playlist.
+
+
+=item $pl->items_changed_since( $plversion )
+
+Return a list with all the songs (as AMC::Item::Song objects) added to
+the playlist since playlist $plversion.
+
+
+=back
+
+
+=head2 Adding / removing songs
+
+=over 4
+
+=item $pl->add( $path [, $path [...] ] )
+
+Add the songs identified by C<$path> (relative to MPD's music directory) to the
+current playlist. No return value.
+
+
+=item $pl->delete( $song [, $song [...] ] )
+
+Remove song number C<$song>s (starting from 0) from the current playlist. No
+return value.
+
+
+=item $pl->deleteid( $songid [, $songid [...] ] )
+
+Remove the specified C<$songid>s (as assigned by mpd when inserted in playlist)
+from the current playlist. No return value.
+
+
+=item $pl->clear()
+
+Remove all the songs from the current playlist. No return value.
+
+
+=item $pl->crop()
+
+Remove all of the songs from the current playlist *except* the
+song currently playing.
+
+
+=back
+
+
+=head2 Changing playlist order
+
+=over 4
+
+=item $pl->shuffle()
+
+Shuffle the current playlist. No return value.
+
+
+=item $pl->swap( $song1, $song2 )
+
+Swap positions of song number C<$song1> and C<$song2> in the current
+playlist. No return value.
+
+
+=item $pl->swapid( $songid1, $songid2 )
+
+Swap the postions of song ID C<$songid1> with song ID C<$songid2> in the
+current playlist. No return value.
+
+
+=item $pl->move( $song, $newpos )
+
+Move song number C<$song> to the position C<$newpos>. No return value.
+
+
+=item $pl->moveid( $songid, $newpos )
+
+Move song ID C<$songid> to the position C<$newpos>. No return value.
+
+
+=back
+
+
+=head2 Managing playlists
+
+=over 4
+
+=item $pl->load( $playlist )
+
+Load list of songs from specified C<$playlist> file. No return value.
+
+
+=item $pl->save( $playlist )
+
+Save the current playlist to a file called C<$playlist> in MPD's playlist
+directory. No return value.
+
+
+=item $pl->rm( $playlist )
+
+Delete playlist named C<$playlist> from MPD's playlist directory. No
+return value.
+
+
+=back
+
+
+=head1 SEE ALSO
+
+L<Audio::MPD>
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Audio/MPD/Test.pm b/config/mpfire/perl/Audio/MPD/Test.pm
new file mode 100644 (file)
index 0000000..74359af
--- /dev/null
@@ -0,0 +1,217 @@
+#
+# This file is part of Audio::MPD
+# Copyright (c) 2007 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+package Audio::MPD::Test;
+
+use strict;
+use warnings;
+
+use Exporter;
+use FindBin     qw[ $Bin ];
+use Readonly;
+
+
+use base qw[ Exporter ];
+our @EXPORT = qw[ customize_test_mpd_configuration start_test_mpd stop_test_mpd ];
+#our ($VERSION) = '$Rev: 5284 $' =~ /(\d+)/;
+
+
+Readonly my $TEMPLATE => "$Bin/mpd-test/mpd.conf.template";
+Readonly my $CONFIG   => "$Bin/mpd-test/mpd.conf";
+
+{ # this will be run when Audio::MPD::Test will be use-d.
+    my $restart = 0;
+    my $stopit  = 0;
+
+    customize_test_mpd_configuration();
+    $restart = _stop_user_mpd_if_needed();
+    $stopit  = start_test_mpd();
+
+    END {
+        stop_test_mpd() if $stopit;
+        return unless $restart;       # no need to restart
+        system 'mpd 2>/dev/null';     # restart user mpd
+        sleep 1;                      # wait 1 second to let mpd start.
+    }
+}
+
+
+#--
+# public subs
+
+#
+# customize_test_mpd_configuration( [$port] )
+#
+# Create a fake mpd configuration file, based on the file mpd.conf.template
+# located in t/mpd-test. The string PWD will be replaced by the real path -
+# ie, where the tarball has been untarred. The string PORT will be replaced
+# by $port if specified, 6600 otherwise (MPD default).
+#
+sub customize_test_mpd_configuration {
+    my ($port) = @_;
+    $port ||= 6600;
+
+    # open template and config.
+    open my $in,  '<',  $TEMPLATE or die "can't open [$TEMPLATE]: $!\n";
+    open my $out, '>',  $CONFIG   or die "can't open [$CONFIG]: $!\n";
+
+    # replace string and fill in config file.
+    while ( defined( my $line = <$in> ) ) {
+        $line =~ s!PWD!$Bin/mpd-test!;
+        $line =~ s!PORT!$port!;
+        print $out $line;
+    }
+
+    # clean up.
+    close $in;
+    close $out;
+
+    # create a fake mpd db.
+    system( "mpd --create-db $CONFIG >/dev/null 2>&1" ) == 0
+        or die "could not create fake mpd database: $?\n";
+}
+
+
+#
+# start_test_mpd()
+#
+# Start the fake mpd, and die if there were any error.
+#
+sub start_test_mpd {
+    my $output = qx[mpd $CONFIG 2>&1];
+    die "could not start fake mpd: $output\n" if $output;
+    sleep 1;   # wait 1 second to let mpd start.
+    return 1;
+}
+
+
+#
+# stop_test_mpd()
+#
+# Kill the fake mpd.
+#
+sub stop_test_mpd {
+    system "mpd --kill $CONFIG 2>/dev/null";
+    sleep 1;   # wait 1 second to free output device.
+    unlink "$Bin/mpd-test/state", "$Bin/mpd-test/music.db";
+}
+
+
+#--
+# private subs
+
+
+#
+# my $was_running = _stop_user_mpd_if_needed()
+#
+# This sub will check if mpd is currently running. If it is, force it to
+# a full stop (unless MPD_TEST_OVERRIDE is not set).
+#
+# In any case, it will return a boolean stating whether mpd was running
+# before forcing stop.
+#
+sub _stop_user_mpd_if_needed {
+    # check if mpd is running.
+    my $is_running = grep { /mpd$/ } qx[ ps -e ];
+
+    return 0 unless $is_running; # mpd does not run - nothing to do.
+
+    # check force stop.
+    die "mpd is running\n" unless $ENV{MPD_TEST_OVERRIDE};
+    system( 'mpd --kill 2>/dev/null') == 0 or die "can't stop user mpd: $?\n";
+    sleep 1;  # wait 1 second to free output device
+    return 1;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Audio::MPD::Test - automate launching of fake mdp for testing purposes
+
+
+=head1 SYNOPSIS
+
+    use Audio::MPD::Test; # die if error
+    [...]
+    stop_fake_mpd();
+
+
+=head1 DESCRIPTION
+
+=head2 General usage
+
+This module will try to launch a new mpd server for testing purposes. This
+mpd server will then be used during Audio::MPD tests.
+
+In order to achieve this, the module will create a fake mpd.conf file with
+the correct pathes (ie, where you untarred the module tarball). It will then
+check if some mpd server is already running, and stop it if the
+MPD_TEST_OVERRIDE environment variable is true (die otherwise). Last it will
+run the test mpd with its newly created configuration file.
+
+Everything described above is done automatically when the module is C<use>-d.
+
+
+Once the tests are run, the mpd server will be shut down, and the original
+one will be relaunched (if there was one).
+
+Note that the test mpd will listen to C<localhost>, so you are on the safe
+side. Note also that the test suite comes with its own ogg files - and yes,
+we can redistribute them since it's only some random voice recordings :-)
+
+
+=head2 Advanced usage
+
+In case you want more control on the test mpd server, you can use the
+following public methods:
+
+=over 4
+
+=item start_test_mpd()
+
+Start the fake mpd, and die if there were any error.
+
+=item stop_test_mpd()
+
+Kill the fake mpd.
+
+=item customize_test_mpd_configuration( [$port] )
+
+Create a fake mpd configuration file, based on the file mpd.conf.template
+located in t/mpd-test. The string PWD will be replaced by the real path -
+ie, where the tarball has been untarred. The string PORT will be replaced
+by $port if specified, 6600 otherwise (MPD default).
+
+=back
+
+This might be useful when trying to test connections with mpd server.
+
+
+=head1 SEE ALSO
+
+L<Audio::MPD>
+
+
+=head1 AUTHOR
+
+Jerome Quelin, C<< <jquelin at cpan.org> >>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Jerome Quelin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/config/mpfire/perl/Readonly.pm b/config/mpfire/perl/Readonly.pm
new file mode 100644 (file)
index 0000000..294c759
--- /dev/null
@@ -0,0 +1,803 @@
+=for gpg
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+- -----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+=head1 NAME
+
+Readonly - Facility for creating read-only scalars, arrays, hashes.
+
+=head1 VERSION
+
+This documentation describes version 1.03 of Readonly.pm, April 20, 2004.
+
+=cut
+
+# Rest of documentation is after __END__.
+
+use 5.005;
+use strict;
+#use warnings;
+#no warnings 'uninitialized';
+
+package Readonly;
+$Readonly::VERSION = '1.03';    # Also change in the documentation!
+
+# Autocroak (Thanks, MJD)
+# Only load Carp.pm if module is croaking.
+sub croak
+{
+    require Carp;
+    goto &Carp::croak;
+}
+
+# These functions may be overridden by Readonly::XS, if installed.
+sub is_sv_readonly   ($) { 0 }
+sub make_sv_readonly ($) { die "make_sv_readonly called but not overridden" }
+use vars qw/$XSokay/;     # Set to true in Readonly::XS, if available
+
+# Common error messages, or portions thereof
+use vars qw/$MODIFY $REASSIGN $ODDHASH/;
+$MODIFY   = 'Modification of a read-only value attempted';
+$REASSIGN = 'Attempt to reassign a readonly';
+$ODDHASH  = 'May not store an odd number of values in a hash';
+
+# See if we can use the XS stuff.
+$Readonly::XS::MAGIC_COOKIE = "Do NOT use or require Readonly::XS unless you're me.";
+eval 'use Readonly::XS';
+
+
+# ----------------
+# Read-only scalars
+# ----------------
+package Readonly::Scalar;
+
+sub TIESCALAR
+{
+    my $whence = (caller 2)[3];    # Check if naughty user is trying to tie directly.
+    Readonly::croak "Invalid tie"  unless $whence && $whence =~ /^Readonly::(?:Scalar1?|Readonly)$/;
+    my $class = shift;
+    Readonly::croak "No value specified for readonly scalar"        unless @_;
+    Readonly::croak "Too many values specified for readonly scalar" unless @_ == 1;
+
+    my $value = shift;
+    return bless \$value, $class;
+}
+
+sub FETCH
+{
+    my $self = shift;
+    return $$self;
+}
+
+*STORE = *UNTIE =
+    sub {Readonly::croak $Readonly::MODIFY};
+
+
+# ----------------
+# Read-only arrays
+# ----------------
+package Readonly::Array;
+
+sub TIEARRAY
+{
+    my $whence = (caller 1)[3];    # Check if naughty user is trying to tie directly.
+    Readonly::croak "Invalid tie"  unless $whence =~ /^Readonly::Array1?$/;
+    my $class = shift;
+    my @self = @_;
+
+    return bless \@self, $class;
+}
+
+sub FETCH
+{
+    my $self  = shift;
+    my $index = shift;
+    return $self->[$index];
+}
+
+sub FETCHSIZE
+{
+    my $self = shift;
+    return scalar @$self;
+}
+
+BEGIN {
+    eval q{
+        sub EXISTS
+           {
+           my $self  = shift;
+           my $index = shift;
+           return exists $self->[$index];
+           }
+    } if $] >= 5.006;    # couldn't do "exists" on arrays before then
+}
+
+*STORE = *STORESIZE = *EXTEND = *PUSH = *POP = *UNSHIFT = *SHIFT = *SPLICE = *CLEAR = *UNTIE =
+    sub {Readonly::croak $Readonly::MODIFY};
+
+
+# ----------------
+# Read-only hashes
+# ----------------
+package Readonly::Hash;
+
+sub TIEHASH
+{
+    my $whence = (caller 1)[3];    # Check if naughty user is trying to tie directly.
+    Readonly::croak "Invalid tie"  unless $whence =~ /^Readonly::Hash1?$/;
+
+    my $class = shift;
+    # must have an even number of values
+    Readonly::croak $Readonly::ODDHASH unless (@_ %2 == 0);
+
+    my %self = @_;
+    return bless \%self, $class;
+}
+
+sub FETCH
+{
+    my $self = shift;
+    my $key  = shift;
+
+    return $self->{$key};
+}
+
+sub EXISTS
+{
+    my $self = shift;
+    my $key  = shift;
+    return exists $self->{$key};
+}
+
+sub FIRSTKEY
+{
+    my $self = shift;
+    my $dummy = keys %$self;
+    return scalar each %$self;
+}
+
+sub NEXTKEY
+{
+    my $self = shift;
+    return scalar each %$self;
+}
+
+*STORE = *DELETE = *CLEAR = *UNTIE =
+    sub {Readonly::croak $Readonly::MODIFY};
+
+
+# ----------------------------------------------------------------
+# Main package, containing convenience functions (so callers won't
+# have to explicitly tie the variables themselves).
+# ----------------------------------------------------------------
+package Readonly;
+use Exporter;
+use vars qw/@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS/;
+push @ISA, 'Exporter';
+push @EXPORT, qw/Readonly/;
+push @EXPORT_OK, qw/Scalar Array Hash Scalar1 Array1 Hash1/;
+
+# Predeclare the following, so we can use them recursively
+sub Scalar ($$);
+sub Array (\@;@);
+sub Hash (\%;@);
+
+# Returns true if a string begins with "Readonly::"
+# Used to prevent reassignment of Readonly variables.
+sub _is_badtype
+{
+    my $type = $_[0];
+    return lc $type if $type =~ s/^Readonly:://;
+    return;
+}
+
+# Shallow Readonly scalar
+sub Scalar1 ($$)
+{
+    croak "$REASSIGN scalar" if is_sv_readonly $_[0];
+    my $badtype = _is_badtype (ref tied $_[0]);
+    croak "$REASSIGN $badtype" if $badtype;
+
+    # xs method: flag scalar as readonly
+    if ($XSokay)
+    {
+        $_[0] = $_[1];
+        make_sv_readonly $_[0];
+        return;
+    }
+
+    # pure-perl method: tied scalar
+    my $tieobj = eval {tie $_[0], 'Readonly::Scalar', $_[1]};
+    if ($@)
+    {
+        croak "$REASSIGN scalar" if substr($@,0,43) eq $MODIFY;
+        die $@;    # some other error?
+    }
+    return $tieobj;
+}
+
+# Shallow Readonly array
+sub Array1 (\@;@)
+{
+    my $badtype = _is_badtype (ref tied $_[0]);
+    croak "$REASSIGN $badtype" if $badtype;
+
+    my $aref = shift;
+    return tie @$aref, 'Readonly::Array', @_;
+}
+
+# Shallow Readonly hash
+sub Hash1 (\%;@)
+{
+    my $badtype = _is_badtype (ref tied $_[0]);
+    croak "$REASSIGN $badtype" if $badtype;
+
+    my $href = shift;
+
+    # If only one value, and it's a hashref, expand it
+    if (@_ == 1  &&  ref $_[0] eq 'HASH')
+    {
+        return tie %$href, 'Readonly::Hash', %{$_[0]};
+    }
+
+    # otherwise, must have an even number of values
+    croak $ODDHASH unless (@_%2 == 0);
+
+    return tie %$href, 'Readonly::Hash', @_;
+}
+
+# Deep Readonly scalar
+sub Scalar ($$)
+{
+    croak "$REASSIGN scalar" if is_sv_readonly $_[0];
+    my $badtype = _is_badtype (ref tied $_[0]);
+    croak "$REASSIGN $badtype" if $badtype;
+
+    my $value = $_[1];
+
+    # Recursively check passed element for references; if any, make them Readonly
+    foreach ($value)
+    {
+        if    (ref eq 'SCALAR') {Scalar my $v => $$_; $_ = \$v}
+        elsif (ref eq 'ARRAY')  {Array  my @v => @$_; $_ = \@v}
+        elsif (ref eq 'HASH')   {Hash   my %v =>  $_; $_ = \%v}
+    }
+
+    # xs method: flag scalar as readonly
+    if ($XSokay)
+    {
+        $_[0] = $value;
+        make_sv_readonly $_[0];
+        return;
+    }
+
+    # pure-perl method: tied scalar
+    my $tieobj = eval {tie $_[0], 'Readonly::Scalar', $value};
+    if ($@)
+    {
+        croak "$REASSIGN scalar" if substr($@,0,43) eq $MODIFY;
+        die $@;    # some other error?
+    }
+    return $tieobj;
+}
+
+# Deep Readonly array
+sub Array (\@;@)
+{
+    my $badtype = _is_badtype (ref tied @{$_[0]});
+    croak "$REASSIGN $badtype" if $badtype;
+
+    my $aref = shift;
+    my @values = @_;
+
+    # Recursively check passed elements for references; if any, make them Readonly
+    foreach (@values)
+    {
+        if    (ref eq 'SCALAR') {Scalar my $v => $$_; $_ = \$v}
+        elsif (ref eq 'ARRAY')  {Array  my @v => @$_; $_ = \@v}
+        elsif (ref eq 'HASH')   {Hash   my %v => $_;  $_ = \%v}
+    }
+    # Lastly, tie the passed reference
+    return tie @$aref, 'Readonly::Array', @values;
+}
+
+# Deep Readonly hash
+sub Hash (\%;@)
+{
+    my $badtype = _is_badtype (ref tied %{$_[0]});
+    croak "$REASSIGN $badtype" if $badtype;
+
+    my $href = shift;
+    my @values = @_;
+
+    # If only one value, and it's a hashref, expand it
+    if (@_ == 1  &&  ref $_[0] eq 'HASH')
+    {
+        @values = %{$_[0]};
+    }
+
+    # otherwise, must have an even number of values
+    croak $ODDHASH unless (@values %2 == 0);
+
+    # Recursively check passed elements for references; if any, make them Readonly
+    foreach (@values)
+    {
+        if    (ref eq 'SCALAR') {Scalar my $v => $$_; $_ = \$v}
+        elsif (ref eq 'ARRAY')  {Array  my @v => @$_; $_ = \@v}
+        elsif (ref eq 'HASH')   {Hash   my %v => $_;  $_ = \%v}
+    }
+
+    return tie %$href, 'Readonly::Hash', @values;
+}
+
+
+# Common entry-point for all supported data types
+eval q{sub Readonly} . ( $] < 5.008 ? '' : '(\[$@%]@)' ) . <<'SUB_READONLY';
+{
+    if (ref $_[0] eq 'SCALAR')
+    {
+        croak $MODIFY if is_sv_readonly ${$_[0]};
+        my $badtype = _is_badtype (ref tied ${$_[0]});
+        croak "$REASSIGN $badtype" if $badtype;
+        croak "Readonly scalar must have only one value" if @_ > 2;
+
+        my $tieobj = eval {tie ${$_[0]}, 'Readonly::Scalar', $_[1]};
+        # Tie may have failed because user tried to tie a constant, or we screwed up somehow.
+        if ($@)
+        {
+            croak $MODIFY if $@ =~ /^$MODIFY at/;    # Point the finger at the user.
+            die "$@\n";        # Not a modify read-only message; must be our fault.
+        }
+        return $tieobj;
+    }
+    elsif (ref $_[0] eq 'ARRAY')
+    {
+        my $aref = shift;
+        return Array @$aref, @_;
+    }
+    elsif (ref $_[0] eq 'HASH')
+    {
+        my $href = shift;
+        croak $ODDHASH  if @_%2 != 0  &&  !(@_ == 1  && ref $_[0] eq 'HASH');
+        return Hash %$href, @_;
+    }
+    elsif (ref $_[0])
+    {
+        croak "Readonly only supports scalar, array, and hash variables.";
+    }
+    else
+    {
+        croak "First argument to Readonly must be a reference.";
+    }
+}
+SUB_READONLY
+
+
+1;
+__END__
+
+=head1 SYNOPSIS
+
+ use Readonly;
+
+ # Read-only scalar
+ Readonly::Scalar     $sca => $initial_value;
+ Readonly::Scalar  my $sca => $initial_value;
+
+ # Read-only array
+ Readonly::Array      @arr => @values;
+ Readonly::Array   my @arr => @values;
+
+ # Read-only hash
+ Readonly::Hash       %has => (key => value, key => value, ...);
+ Readonly::Hash    my %has => (key => value, key => value, ...);
+ # or:
+ Readonly::Hash       %has => {key => value, key => value, ...};
+
+ # You can use the read-only variables like any regular variables:
+ print $sca;
+ $something = $sca + $arr[2];
+ next if $has{$some_key};
+
+ # But if you try to modify a value, your program will die:
+ $sca = 7;
+ push @arr, 'seven';
+ delete $has{key};
+ # The error message is "Modification of a read-only value
+attempted"
+
+ # Alternate form (Perl 5.8 and later)
+ Readonly    $sca => $initial_value;
+ Readonly my $sca => $initial_value;
+ Readonly    @arr => @values;
+ Readonly my @arr => @values;
+ Readonly    %has => (key => value, key => value, ...);
+ Readonly my %has => (key => value, key => value, ...);
+ # Alternate form (for Perls earlier than v5.8)
+ Readonly    \$sca => $initial_value;
+ Readonly \my $sca => $initial_value;
+ Readonly    \@arr => @values;
+ Readonly \my @arr => @values;
+ Readonly    \%has => (key => value, key => value, ...);
+ Readonly \my %has => (key => value, key => value, ...);
+
+
+=head1 DESCRIPTION
+
+This is a facility for creating non-modifiable variables.  This is
+useful for configuration files, headers, etc.  It can also be useful
+as a development and debugging tool, for catching updates to variables
+that should not be changed.
+
+If any of the values you pass to C<Scalar>, C<Array>, or C<Hash> are
+references, then those functions recurse over the data structures,
+marking everything as Readonly.  Usually, this is what you want: the
+entire structure nonmodifiable.  If you want only the top level to be
+Readonly, use the alternate C<Scalar1>, C<Array1> and C<Hash1>
+functions.
+
+Please note that most users of Readonly will also want to install a
+companion module Readonly::XS.  See the L</CONS> section below for more
+details.
+
+=head1 COMPARISON WITH "use constant"
+
+Perl provides a facility for creating constant values, via the "use
+constant" pragma.  There are several problems with this pragma.
+
+=over 2
+
+=item *
+
+The constants created have no leading $ or @ character.
+
+=item *
+
+These constants cannot be interpolated into strings.
+
+=item *
+
+Syntax can get dicey sometimes.  For example:
+
+ use constant CARRAY => (2, 3, 5, 7, 11, 13);
+ $a_prime = CARRAY[2];        # wrong!
+ $a_prime = (CARRAY)[2];      # right -- MUST use parentheses
+
+=item *
+
+You have to be very careful in places where barewords are allowed.
+For example:
+
+ use constant SOME_KEY => 'key';
+ %hash = (key => 'value', other_key => 'other_value');
+ $some_value = $hash{SOME_KEY};        # wrong!
+ $some_value = $hash{+SOME_KEY};       # right
+
+(who thinks to use a unary plus when using a hash?)
+
+=item *
+
+C<use constant> works for scalars and arrays, not hashes.
+
+=item *
+
+These constants are global ot the package in which they're declared;
+cannot be lexically scoped.
+
+=item *
+
+Works only at compile time.
+
+=item *
+
+Can be overridden:
+
+ use constant PI => 3.14159;
+ ...
+ use constant PI => 2.71828;
+
+(this does generate a warning, however, if you have warnings enabled).
+
+=item *
+
+It is very difficult to make and use deep structures (complex data
+structures) with C<use constant>.
+
+=back
+
+=head1 COMPARISON WITH TYPEGLOB CONSTANTS
+
+Another popular way to create read-only scalars is to modify the symbol
+table entry for the variable by using a typeglob:
+
+ *a = \'value';
+
+This works fine, but it only works for global variables ("my"
+variables have no symbol table entry).  Also, the following similar
+constructs do B<not> work:
+
+ *a = [1, 2, 3];      # Does NOT create a read-only array
+ *a = { a => 'A'};    # Does NOT create a read-only hash
+
+=head1 PROS
+
+Readonly.pm, on the other hand, will work with global variables and
+with lexical ("my") variables.  It will create scalars, arrays, or
+hashes, all of which look and work like normal, read-write Perl
+variables.  You can use them in scalar context, in list context; you
+can take references to them, pass them to functions, anything.
+
+Readonly.pm also works well with complex data structures, allowing you
+to tag the whole structure as nonmodifiable, or just the top level.
+
+Also, Readonly variables may not be reassigned.  The following code
+will die:
+
+ Readonly::Scalar $pi => 3.14159;
+ ...
+ Readonly::Scalar $pi => 2.71828;
+
+=head1 CONS
+
+Readonly.pm does impose a performance penalty.  It's pretty slow.  How
+slow?  Run the C<benchmark.pl> script that comes with Readonly.  On my
+test system, "use constant", typeglob constants, and regular
+read/write Perl variables were all about the same speed, and
+Readonly.pm constants were about 1/20 the speed.
+
+However, there is relief.  There is a companion module available,
+Readonly::XS.  If it is installed on your system, Readonly.pm uses it
+to make read-only scalars much faster.  With Readonly::XS, Readonly
+scalars are as fast as the other types of variables.  Readonly arrays
+and hashes will still be relatively slow.  But it's likely that most
+of your Readonly variables will be scalars.
+
+If you can't use Readonly::XS (for example, if you don't have a C
+compiler, or your perl is statically linked and you don't want to
+re-link it), you have to decide whether the benefits of Readonly
+variables outweigh the speed issue. For most configuration variables
+(and other things that Readonly is likely to be useful for), the speed
+issue is probably not really a big problem.  But benchmark your
+program if it might be.  If it turns out to be a problem, you may
+still want to use Readonly.pm during development, to catch changes to
+variables that should not be changed, and then remove it for
+production:
+
+ # For testing:
+ Readonly::Scalar  $Foo_Directory => '/usr/local/foo';
+ Readonly::Scalar  $Bar_Directory => '/usr/local/bar';
+ # $Foo_Directory = '/usr/local/foo';
+ # $Bar_Directory = '/usr/local/bar';
+
+ # For production:
+ # Readonly::Scalar  $Foo_Directory => '/usr/local/foo';
+ # Readonly::Scalar  $Bar_Directory => '/usr/local/bar';
+ $Foo_Directory = '/usr/local/foo';
+ $Bar_Directory = '/usr/local/bar';
+
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item Readonly::Scalar $var => $value;
+
+Creates a nonmodifiable scalar, C<$var>, and assigns a value of
+C<$value> to it.  Thereafter, its value may not be changed.  Any
+attempt to modify the value will cause your program to die.
+
+A value I<must> be supplied.  If you want the variable to have
+C<undef> as its value, you must specify C<undef>.
+
+If C<$value> is a reference to a scalar, array, or hash, then this
+function will mark the scalar, array, or hash it points to as being
+Readonly as well, and it will recursively traverse the structure,
+marking the whole thing as Readonly.  Usually, this is what you want.
+However, if you want only the C<$value> marked as Readonly, use
+C<Scalar1>.
+
+If $var is already a Readonly variable, the program will die with
+an error about reassigning Readonly variables.
+
+=item Readonly::Array @arr => (value, value, ...);
+
+Creates a nonmodifiable array, C<@arr>, and assigns the specified list
+of values to it.  Thereafter, none of its values may be changed; the
+array may not be lengthened or shortened or spliced.  Any attempt to
+do so will cause your program to die.
+
+If any of the values passed is a reference to a scalar, array, or hash,
+then this function will mark the scalar, array, or hash it points to as
+being Readonly as well, and it will recursively traverse the structure,
+marking the whole thing as Readonly.  Usually, this is what you want.
+However, if you want only the hash C<%@arr> itself marked as Readonly,
+use C<Array1>.
+
+If @arr is already a Readonly variable, the program will die with
+an error about reassigning Readonly variables.
+
+=item Readonly::Hash %h => (key => value, key => value, ...);
+
+=item Readonly::Hash %h => {key => value, key => value, ...};
+
+Creates a nonmodifiable hash, C<%h>, and assigns the specified keys
+and values to it.  Thereafter, its keys or values may not be changed.
+Any attempt to do so will cause your program to die.
+
+A list of keys and values may be specified (with parentheses in the
+synopsis above), or a hash reference may be specified (curly braces in
+the synopsis above).  If a list is specified, it must have an even
+number of elements, or the function will die.
+
+If any of the values is a reference to a scalar, array, or hash, then
+this function will mark the scalar, array, or hash it points to as
+being Readonly as well, and it will recursively traverse the
+structure, marking the whole thing as Readonly.  Usually, this is what
+you want.  However, if you want only the hash C<%h> itself marked as
+Readonly, use C<Hash1>.
+
+If %h is already a Readonly variable, the program will die with
+an error about reassigning Readonly variables.
+
+=item Readonly $var => $value;
+
+=item Readonly @arr => (value, value, ...);
+
+=item Readonly %h => (key => value, ...);
+
+=item Readonly %h => {key => value, ...};
+
+The C<Readonly> function is an alternate to the C<Scalar>, C<Array>,
+and C<Hash> functions.  It has the advantage (if you consider it an
+advantage) of being one function.  That may make your program look
+neater, if you're initializing a whole bunch of constants at once.
+You may or may not prefer this uniform style.
+
+It has the disadvantage of having a slightly different syntax for
+versions of Perl prior to 5.8.  For earlier versions, you must supply
+a backslash, because it requires a reference as the first parameter.
+
+  Readonly \$var => $value;
+  Readonly \@arr => (value, value, ...);
+  Readonly \%h => (key => value, ...);
+  Readonly \%h => {key => value, ...};
+
+You may or may not consider this ugly.
+
+=item Readonly::Scalar1 $var => $value;
+
+=item Readonly::Array1 @arr => (value, value, ...);
+
+=item Readonly::Hash1 %h => (key => value, key => value, ...);
+
+=item Readonly::Hash1 %h => {key => value, key => value, ...};
+
+These alternate functions create shallow Readonly variables, instead
+of deep ones.  For example:
+
+ Readonly::Array1 @shal => (1, 2, {perl=>'Rules', java=>'Bites'}, 4, 5);
+ Readonly::Array  @deep => (1, 2, {perl=>'Rules', java=>'Bites'}, 4, 5);
+
+ $shal[1] = 7;           # error
+ $shal[2]{APL}='Weird';  # Allowed! since the hash isn't Readonly
+ $deep[1] = 7;           # error
+ $deep[2]{APL}='Weird';  # error, since the hash is Readonly
+
+
+=back
+
+
+=head1 EXAMPLES
+
+ # SCALARS:
+
+ # A plain old read-only value
+ Readonly::Scalar $a => "A string value";
+
+ # The value need not be a compile-time constant:
+ Readonly::Scalar $a => $computed_value;
+
+
+ # ARRAYS:
+
+ # A read-only array:
+ Readonly::Array @a => (1, 2, 3, 4);
+
+ # The parentheses are optional:
+ Readonly::Array @a => 1, 2, 3, 4;
+
+ # You can use Perl's built-in array quoting syntax:
+ Readonly::Array @a => qw/1 2 3 4/;
+
+ # You can initialize a read-only array from a variable one:
+ Readonly::Array @a => @computed_values;
+
+ # A read-only array can be empty, too:
+ Readonly::Array @a => ();
+ Readonly::Array @a;        # equivalent
+
+
+ # HASHES
+
+ # Typical usage:
+ Readonly::Hash %a => (key1 => 'value1', key2 => 'value2');
+
+ # A read-only hash can be initialized from a variable one:
+ Readonly::Hash %a => %computed_values;
+
+ # A read-only hash can be empty:
+ Readonly::Hash %a => ();
+ Readonly::Hash %a;        # equivalent
+
+ # If you pass an odd number of values, the program will die:
+ Readonly::Hash %a => (key1 => 'value1', "value2");
+     --> dies with "May not store an odd number of values in a hash"
+
+
+=head1 EXPORTS
+
+By default, this module exports the following symbol into the calling
+program's namespace:
+
+ Readonly
+
+The following symbols are available for import into your program, if
+you like:
+
+ Scalar  Scalar1
+ Array   Array1
+ Hash    Hash1
+
+
+=head1 REQUIREMENTS
+
+ Perl 5.000
+ Carp.pm (included with Perl)
+ Exporter.pm (included with Perl)
+
+ Readonly::XS is recommended but not required.
+
+=head1 ACKNOWLEDGEMENTS
+
+Thanks to Slaven Rezic for the idea of one common function
+(Readonly) for all three types of variables (13 April 2002).
+
+Thanks to Ernest Lergon for the idea (and initial code) for
+deeply-Readonly data structures (21 May 2002).
+
+Thanks to Damian Conway for the idea (and code) for making the
+Readonly function work a lot smoother under perl 5.8+.
+
+
+=head1 AUTHOR / COPYRIGHT
+
+Eric J. Roode, roode@cpan.org
+
+Copyright (c) 2001-2004 by Eric J. Roode. All Rights Reserved.  This
+module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+If you have suggestions for improvement, please drop me a line.  If
+you make improvements to this software, I ask that you please send me
+a copy of your changes. Thanks.
+
+Readonly.pm is made from 100% recycled electrons.  No animals were
+harmed during the development and testing of this module.  Not sold
+in stores!  Readonly::XS sold separately.  Void where prohibited.
+
+=cut
+
+=begin gpg
+
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.2.4 (MingW32)
+
+iD8DBQFAhaGCY96i4h5M0egRAg++AJ0ar4ncojbOp0OOc2wo+E/1cBn5cQCg9eP9
+qTzAC87PuyKB+vrcRykrDbo=
+=39Ny
+-----END PGP SIGNATURE-----
+
+=cut
\ No newline at end of file
diff --git a/html/html/images/media-playback-start-all.png b/html/html/images/media-playback-start-all.png
new file mode 100644 (file)
index 0000000..05cc4c6
Binary files /dev/null and b/html/html/images/media-playback-start-all.png differ
diff --git a/html/html/images/media-repeat.png b/html/html/images/media-repeat.png
new file mode 100644 (file)
index 0000000..32a38e0
Binary files /dev/null and b/html/html/images/media-repeat.png differ
diff --git a/html/html/images/media-shuffle.png b/html/html/images/media-shuffle.png
new file mode 100644 (file)
index 0000000..ef4d922
Binary files /dev/null and b/html/html/images/media-shuffle.png differ
diff --git a/html/html/images/mpfire/box.png b/html/html/images/mpfire/box.png
new file mode 100644 (file)
index 0000000..fdf97b3
Binary files /dev/null and b/html/html/images/mpfire/box.png differ