Commits

Anonymous committed 0db0895

Added File-Find-Object-Rule-MMagic - now passing ./Build distruntest.

  • Participants
  • Parent commits 1814f05

Comments (0)

Files changed (7)

File-Find-Object-Rule-MMagic/Build.PL

+# This file is under the MIT X11 License:
+# http://www.opensource.org/licenses/mit-license.php
+
+use strict;
+use warnings;
+
+use File::Spec;
+use lib File::Spec->catdir(File::Spec->curdir(), "inc");
+
+use Test::Run::Builder;
+
+my $build = Test::Run::Builder->new(
+    module_name => "File::Find::Object::Rule::MMagic",
+    license     => 'perl',
+    dist_author => 'Shlomi Fish <shlomif@cpan.org>',
+    requires    => {
+        'Text::Glob' => 0,
+        'File::Find::Object::Rule' => 0,
+        'File::MMagic' => 0,
+        'vars'               => 0,
+        'warnings'           => 0,
+    },
+    build_requires => {
+        'Test::More'      => 0,
+    },
+    create_makefile_pl => 'traditional',
+    meta_merge =>
+    {
+        resources =>
+        {
+            repository => "http://svn.berlios.de/svnroot/repos/web-cpan/File-Find-Object/",
+            homepage => "http://www.shlomifish.org/open-source/projects/File-Find-Object/",
+        },
+        keywords =>
+        [
+            "file",
+            "file extensions",
+            "file-find-object-rule",
+            "file-find-rule",
+            "file types",
+            "find",
+            "mime",
+            "MIME",
+            "mime types",
+            "mmagic",
+            "object",
+            "types",
+        ],
+    },
+);
+
+$build->create_build_script;
+

File-Find-Object-Rule-MMagic/MANIFEST

+Build.PL
+inc/Test/Run/Builder.pm
+lib/File/Find/Object/Rule/MMagic.pm
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+t/File-Find-Object-Rule-MMagic.t
+t/happy-baby.JPG
+META.yml

File-Find-Object-Rule-MMagic/MANIFEST.SKIP

+\.cvsignore
+\.svn
+^Makefile$
+~$

File-Find-Object-Rule-MMagic/inc/Test/Run/Builder.pm

+package Test::Run::Builder;
+
+use strict;
+use warnings;
+
+use Module::Build;
+
+use vars qw(@ISA);
+
+@ISA = (qw(Module::Build));
+
+sub ACTION_runtest
+{
+    my ($self) = @_;
+    my $p = $self->{properties};
+
+    $self->depends_on('code');
+
+    local @INC = @INC;
+
+    # Make sure we test the module in blib/
+    unshift @INC, (File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'),
+		 File::Spec->catdir($p->{base_dir}, $self->blib, 'arch'));
+
+    $self->do_test_run_tests;
+}
+
+sub ACTION_distruntest {
+  my ($self) = @_;
+
+  $self->depends_on('distdir');
+
+  my $start_dir = $self->cwd;
+  my $dist_dir = $self->dist_dir;
+  chdir $dist_dir or die "Cannot chdir to $dist_dir: $!";
+  # XXX could be different names for scripts
+
+  $self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile
+      or die "Error executing 'Build.PL' in dist directory: $!";
+  $self->run_perl_script('Build')
+      or die "Error executing 'Build' in dist directory: $!";
+  $self->run_perl_script('Build', [], ['runtest'])
+      or die "Error executing 'Build test' in dist directory";
+  chdir $start_dir;
+}
+
+sub do_test_run_tests
+{
+    my $self = shift;
+
+    require Test::Run::CmdLine::Iface;
+
+    my $test_run =
+        Test::Run::CmdLine::Iface->new(
+            {
+                'test_files' => [glob("t/*.t")],
+            }   
+            # 'backend_params' => $self->_get_backend_params(),
+        );
+
+    return $test_run->run();
+}
+
+sub ACTION_tags
+{
+    return 
+        system(qw(
+            ctags -f tags --recurse --totals
+    		--exclude=blib/ --exclude=t/lib
+    		--exclude=.svn --exclude='*~'
+    		--languages=Perl --langmap=Perl:+.t
+    ));
+}
+
+1;
+

File-Find-Object-Rule-MMagic/lib/File/Find/Object/Rule/MMagic.pm

+# $Id: MMagic.pm 877 2002-10-29 11:16:05Z richardc $
+package File::Find::Object::Rule::MMagic;
+
+use strict;
+use warnings;
+
+use File::Find::Object::Rule;
+use base qw( File::Find::Object::Rule );
+use vars qw( $VERSION @EXPORT );
+@EXPORT  = @File::Find::Object::Rule::EXPORT;
+$VERSION = '0.02';
+
+use File::MMagic;
+use Text::Glob qw(glob_to_regex);
+
+sub File::Find::Object::Rule::magic {
+    my $self = shift()->_force_object;
+    my @patterns = map { ref $_ ? $_ : glob_to_regex $_ } @_;
+    my $mm = new File::MMagic;
+    $self->exec( sub {
+                     my (undef, undef, $path) = @_;
+                     my $type = $mm->checktype_filename($path);
+                     for my $pat (@patterns) 
+                     { 
+                         return 1 if $type =~ m/$pat/ 
+                     }
+                     return;
+                 } );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::Find::Rule::MMagic - rule to match on mime types
+
+=head1 SYNOPSIS
+
+ use File::Find::Rule::MMagic;
+ my @images = find( file => magic => 'image/*', in => '.' );
+
+=head1 DESCRIPTION
+
+File::Find::Rule::MMagic interfaces File::MMagic to File::Find::Rule
+enabling you to find files based upon their mime type.  Text::Glob
+is used so that the patter may be a simple globbing pattern.
+
+=head2 ->magic( @patterns )
+
+Match only things with the mime types specified by @patterns.  The
+specification can be a glob pattern, as provided by L<Text::Glob>.
+
+=head1 AUTHOR
+
+Richard Clamp <richardc@unixbeard.net>, from an idea by Mark Fowler.
+
+Adapted to L<File::Find::Object::Rule::MMagic> by Shlomi Fish. All rights
+disclaimed.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002 Richard Clamp.  All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<File::Find::Object::Rule>, L<Text::Glob>, L<File::MMagic>
+
+Originally derived from L<File::Find::Rule::MMagic>
+
+=cut

File-Find-Object-Rule-MMagic/t/File-Find-Object-Rule-MMagic.t

+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+use File::Find::Object::Rule::MMagic;
+# TEST
+is_deeply( [ find( magic => 'image/*', maxdepth => 2, in => 't' ) ],
+           [ 't/happy-baby.JPG' ] );

File-Find-Object-Rule-MMagic/t/happy-baby.JPG

Added
New image