initial commit

diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..2b24810
--- /dev/null
+++ b/Changes
@@ -0,0 +1,2 @@
+0.001000 2010-02-26 07:30EST
+ - Initial release
\ No newline at end of file

diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644 (file)
index 0000000..5b18801
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,31 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\b\.#
+\.DS_Store$
+\.\#
+
+# No tarballs!
+\.gz$
+\.git.*
\ No newline at end of file

diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..eefb79b
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,23 @@
+
+use strict;
+use warnings;
+use inc::Module::Install;
+
+# Define metadata
+name 'MooseX-Types-Log-Dispatch';
+abstract 'Moose type-constraints and coercions for Log::Dispatch.';
+all_from 'lib/MooseX/Types/Log/Dispatch.pm';
+
+# Specific dependencies
+requires 'Moose';
+requires 'Log::Dispatch';
+requires 'MooseX::Types';
+
+test_requires 'Test::More';
+test_requires 'Test::Exception';
+
+resources 'IRC' => 'irc://irc.perl.org/#moose';
+resources 'license' => 'http://dev.perl.org/licenses/';
+resources 'repository' => 'git://git.moose.perl.org/MooseX-Types-Log-Dispatch.git';
+
+WriteAll;

diff --git a/lib/MooseX/Types/Log/Dispatch.pm b/lib/MooseX/Types/Log/Dispatch.pm
new file mode 100644 (file)
index 0000000..a2e0f62
--- /dev/null
+++ b/lib/MooseX/Types/Log/Dispatch.pm
@@ -0,0 +1,97 @@
+package MooseX::Types::Log::Dispatch;
+
+use MooseX::Types -declare => [ 'LogLevel', 'Logger' ];
+
+use MooseX::Types::Moose qw/Str HashRef ArrayRef/;
+use Log::Dispatch;
+
+subtype LogLevel,
+  as Str,
+  where { Log::Dispatch->level_is_valid( $_ ) },
+  message { "'$_' is not a valid Log::Dispatch log level." };
+
+class_type Logger, { class => 'Log::Dispatch' };
+
+coerce Logger,
+  from HashRef,
+  via { Log::Dispatch->new( %$_ ) };
+
+coerce Logger,
+  from ArrayRef,
+  via { Log::Dispatch->new( @$_ ) };
+
+1;
+
+__END__;
+
+
+=head1 NAME
+
+MooseX::Types::Log::Dispatch - L<Log::Dispatch> related constraints and coercions for
+Moose
+
+=head1 SYNOPSIS
+
+    package MyFoo;
+    use MooseX::Types::Log::Dispatch qw(Logger LogLevel);
+
+    has logger => (
+        isa => Logger,
+        is => 'ro',
+        coerce => 1,
+    );
+
+    has event_log_level => (
+        isa => LogLevel,
+        is => 'ro',
+    );
+
+    sub some_event_happened {
+      my ($self, $event) = @_;
+      $self->logger->log( level => $self->event_log_level, message => "$event happened");
+    }
+
+    my $obj1 = MyFoos->new(
+      event_log_level => 'debug',
+      logger => [ outputs => [ ['Screen', min_level => 'notice' ] ] ]
+    );
+
+    ## or
+
+    my $obj2 = MyFoos->new(
+      event_log_level => 'warning',
+      logger => { outputs => [ ['Screen', min_level => 'debug' ] ] }
+    );
+
+    $obj1->some_event_happened('zoom'); #nothing prints
+    $obj2->some_event_happened('zoom'); # 'zoom happened' prints
+
+=head1 DESCRIPTION
+
+This module provides Moose TypeConstraints that are believed to be useful when
+working with Log::Dispatch;
+
+=head1 AVAILABLE CONSTRAINTS
+
+=head2 Logger
+
+Class type for 'Log::Dispatch' optional coercion will turn dereference an
+array or hash reference and pass it to 'new'.
+
+=head2 LogLevel
+
+A subtype of 'Str', this should be a string that is a valid L<Log::Dispatch>
+log level like: 0, 1, 2 ,3 ,4 ,5 ,6 ,7, info, debug, notice, warn, warning,
+err, error, crit, critical, alert, emerg, and emergency
+
+=head1 AUTHOR
+
+Guillermo Roditi (groditi) E<lt>groditi@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2010 Guillermo Roditi. This program is free software; you can 
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+

diff --git a/t/types.t b/t/types.t
new file mode 100644 (file)
index 0000000..9db39cf
--- /dev/null
+++ b/t/types.t
@@ -0,0 +1,59 @@
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::Exception;
+
+#laziest test suite EVER. but it works and whatever its a brain-dead simple module
+
+{
+  package TestMXTypesLogDispatch;
+  use Moose;
+  use MooseX::Types::Log::Dispatch qw(Logger LogLevel);
+
+  has logger => (
+    isa => Logger,
+    is => 'ro',
+    coerce => 1,
+  );
+
+  has event_log_level => (
+    isa => LogLevel,
+    is => 'ro',
+  );
+
+  sub some_event_happened {
+    my ($self, $event) = @_;
+    $self->logger->log( level => $self->event_log_level, message => "$event happened");
+  }
+}
+
+dies_ok {
+  TestMXTypesLogDispatch->new( event_log_level => 'debbbug', );
+} 'dies ok';
+
+lives_ok {
+  TestMXTypesLogDispatch->new( event_log_level => 'debug', );
+} 'lives ok';
+
+my $obj1;
+lives_ok {
+  $obj1 = TestMXTypesLogDispatch->new(
+    event_log_level => 'debug',
+    logger => [ outputs => [ ['Null', min_level => 'notice' ] ] ]
+  );
+} 'coerces ok';
+
+## or
+my $obj2;
+lives_ok {
+  $obj2 = TestMXTypesLogDispatch->new(
+    event_log_level => 'warn',
+    logger => { outputs => [ ['Null', min_level => 'debug' ] ] }
+  );
+} 'coerces ok';
+
+lives_ok {
+  $obj1->some_event_happened('zoom');
+  $obj2->some_event_happened('zoom');
+} 'logging actually works';