| Subject: | plugins system change |
I've attached a patch against AudioFile::Info v 1.08 that offers a nicer method of adding/removing plugins, something similar to XML::SAX add/remove_parser.
This way I was able to make plugins packaging a lot easier, adding postambles like:
# post install
AudioFile::Info->add_plugin( q[AudioFile::Info::MP3::ID3Lib],
{read_mp3 => 1, write_mp3 => 1, pure_perl => 0} );
# before uninstall
AudioFile::Info->remove_plugin(q[AudioFile::Info::MP3::ID3Lib]);
(For conformity, the packages I mentioned are to be working on Fedora Core Linux and are currently available at: http://linux.reb00t.com/SRPMS/)
best regards.
diff -urw AudioFile-Info-1.08.orig/lib/AudioFile/Info.pm AudioFile-Info-1.08/lib/AudioFile/Info.pm
--- AudioFile-Info-1.08.orig/lib/AudioFile/Info.pm 2005-03-01 11:49:41.000000000 +0200
+++ AudioFile-Info-1.08/lib/AudioFile/Info.pm 2005-07-31 19:21:34.000000000 +0300
@@ -144,8 +144,9 @@
use strict;
use warnings;
use Carp;
-
-use YAML 'LoadFile';
+use YAML ();
+use File::Basename ();
+use File::Spec ();
our $VERSION = sprintf "%d.%02d", '$Revision: 1.8 $ ' =~ /(\d+)\.(\d+)/;
@@ -174,10 +175,6 @@
my $param = shift || {};
- my $path = $INC{'AudioFile/Info.pm'};
-
- $path =~ s/Info.pm$/plugins.yaml/;
-
my ($ext) = $file =~ /\.(\w+)$/;
die "Can't work out the type of the file $file\n"
unless defined $ext;
@@ -187,7 +184,7 @@
my $pkg = $param->{$ext};
unless (defined $pkg) {
- my $config = LoadFile($path);
+ my $config = $class->_get_plugins;
die "No default $ext file handler\n"
unless exists $config->{default}{$ext};
@@ -201,11 +198,137 @@
return $pkg->new($file);
}
+=head2 AudioFile::Info->add_plugin(MODULE_NAME, MODULE_CONFIGURATION_HASHREF)
+
+This methods adds an L<AudioFile::Info> plugin.
+
+It takes two mandatory arguments, which are the full module name of the plugin
+to be added and its configuration (provided as HashRef).
+
+The configuration should look something like:
+
+ {
+ read_mp3 => 1,
+ write_mp3 => 1,
+ pure_perl => 1,
+ }
+
+Replace I<mp3> above with whatever audio format your plugin deals with.
+
+Same goes with the value of I<pure_perl>, which determines if your plugin is
+written is pure perl or uses some L<XS|perlxs> code.
+
+=cut
+
+sub add_plugin {
+ my ($class, $pkg, $cf) = @_;
+ die 'Forgot to provide the configuration hashref'
+ unless $cf && ref $cf && ref $cf eq 'HASH';
+ my $plugins = $class->_get_plugins;
+ if (exists $plugins->{$pkg}) {
+ warn "$pkg already added!\n";
+ return;
+ }
+ # set default plugin if scores higher
+ foreach my $format ($class->_parse_plugin_config($cf)) {
+ if (!exists $plugins->{default}{$format}
+ || $cf->{"score_$format"} >= $plugins->{default}{$format}{score})
+ {
+ $plugins->{default}{$format} = {
+ name => $pkg,
+ score => $cf->{"score_$format"}
+ };
+ warn "$class - Default $format handler is now $pkg\n";
+ }
+ }
+ $plugins->{$pkg} = $cf;
+ $class->_save_plugins($plugins);
+}
+
+=head2 AudioFile::Info->remove_plugin(MODULE_NAME)
+
+This methods removes an L<AudioFile::Info> plugin.
+
+It takes one mandatory argument, which is the full module name of the plugin
+to be removed.
+
+=cut
+
+sub remove_plugin {
+ my ($class, $pkg) = @_;
+ my $plugins = $class->_get_plugins;
+ unless (exists $plugins->{$pkg}) {
+ warn "$pkg was never added.\n";
+ return;
+ }
+ # drop it from plugins list
+ delete $plugins->{$pkg};
+ # drop it also from "default plugin for XXX" tree
+ foreach my $format (keys %{$plugins->{default}}) {
+ next unless $plugins->{default}{$format}{name} eq $pkg;
+ # take care to replace it with something else if available
+ my $next_plugin = '';
+ my $next_plugin_score = 0;
+ while (my ($name, $cf) = each %$plugins) {
+ next if $name eq 'default';
+ next unless exists $cf->{"score_$format"};
+ next if $next_plugin_score >= $cf->{"score_$format"};
+ $next_plugin = $name;
+ $next_plugin_score = $cf->{"score_$format"};
+ }
+ if ($next_plugin_score) {
+ $plugins->{default}{$format} = {
+ name => $next_plugin,
+ score => $next_plugin_score,
+ };
+ } else {
+ delete $plugins->{default}{$format};
+ }
+ }
+ $class->_save_plugins($plugins);
+}
+
+sub _parse_plugin_config {
+ my ($class, $cf) = @_;
+ # find out what formats this plugin supports
+ my %support = map { s/^(?:read|write)_//; $_ => 1}
+ grep { /^(?:read|write)_/ && $cf->{$_} } keys %$cf;
+ my @support = sort keys %support;
+ die 'Invalid configuration hash: Does not support anything?!' unless @support;
+ # compute scores if necessary
+ foreach my $format (@support) {
+ my $key = 'score_' . $format;
+ next if $cf->{$key};
+ $cf->{$key} += 10 unless $cf->{pure_perl};
+ foreach (qw[read write]) {
+ $cf->{$key} += 50 if $cf->{"${_}_$format"}
+ }
+ }
+ return wantarray ? @support : \@support;
+}
+
+sub _get_plugins_filepath {
+ File::Spec->catfile(
+ File::Basename::dirname($INC{'AudioFile/Info.pm'}),
+ 'plugins.yaml'
+ );
+}
+
+sub _get_plugins {
+ my $plugins_file = shift->_get_plugins_filepath;
+ return -f $plugins_file ? YAML::LoadFile($plugins_file) : {};
+}
+
+sub _save_plugins {
+ my $plugins_file = shift->_get_plugins_filepath;
+ YAML::DumpFile($plugins_file, shift);
+}
+
1;
__END__
-=head2 EXPORT
+=head1 EXPORT
None.
Only in AudioFile-Info-1.08: Makefile.PL