lib/MooseX/Types/Log/Dispatch.pm

   1 package MooseX::Types::Log::Dispatch;
   2
   3 use MooseX::Types -declare => [ 'LogLevel', 'Logger' ];
   4
   5 use MooseX::Types::Moose qw/Str HashRef ArrayRef/;
   6 use Log::Dispatch;
   7
   8 subtype LogLevel,
   9   as Str,
  10   where { Log::Dispatch->level_is_valid( $_ ) },
  11   message { "'$_' is not a valid Log::Dispatch log level." };
  12
  13 class_type Logger, { class => 'Log::Dispatch' };
  14
  15 coerce Logger,
  16   from HashRef,
  17   via { Log::Dispatch->new( %$_ ) };
  18
  19 coerce Logger,
  20   from ArrayRef,
  21   via { Log::Dispatch->new( @$_ ) };
  22
  23 1;
  24
  25 __END__;
  26
  27
  28 =head1 NAME
  29
  30 MooseX::Types::Log::Dispatch - L<Log::Dispatch> related constraints and coercions for
  31 Moose
  32
  33 =head1 SYNOPSIS
  34
  35     package MyFoo;
  36     use MooseX::Types::Log::Dispatch qw(Logger LogLevel);
  37
  38     has logger => (
  39         isa => Logger,
  40         is => 'ro',
  41         coerce => 1,
  42     );
  43
  44     has event_log_level => (
  45         isa => LogLevel,
  46         is => 'ro',
  47     );
  48
  49     sub some_event_happened {
  50       my ($self, $event) = @_;
  51       $self->logger->log( level => $self->event_log_level, message => "$event happened");
  52     }
  53
  54     my $obj1 = MyFoos->new(
  55       event_log_level => 'debug',
  56       logger => [ outputs => [ ['Screen', min_level => 'notice' ] ] ]
  57     );
  58
  59     ## or
  60
  61     my $obj2 = MyFoos->new(
  62       event_log_level => 'warning',
  63       logger => { outputs => [ ['Screen', min_level => 'debug' ] ] }
  64     );
  65
  66     $obj1->some_event_happened('zoom'); #nothing prints
  67     $obj2->some_event_happened('zoom'); # 'zoom happened' prints
  68
  69 =head1 DESCRIPTION
  70
  71 This module provides Moose TypeConstraints that are believed to be useful when
  72 working with Log::Dispatch;
  73
  74 =head1 AVAILABLE CONSTRAINTS
  75
  76 =head2 Logger
  77
  78 Class type for 'Log::Dispatch' optional coercion will turn dereference an
  79 array or hash reference and pass it to 'new'.
  80
  81 =head2 LogLevel
  82
  83 A subtype of 'Str', this should be a string that is a valid L<Log::Dispatch>
  84 log level like: 0, 1, 2 ,3 ,4 ,5 ,6 ,7, info, debug, notice, warn, warning,
  85 err, error, crit, critical, alert, emerg, and emergency
  86
  87 =head1 AUTHOR
  88
  89 Guillermo Roditi (groditi) E<lt>groditi@cpan.orgE<gt>
  90
  91 =head1 COPYRIGHT AND LICENSE
  92
  93 Copyright (c) 2010 Guillermo Roditi. This program is free software; you can
  94 redistribute it and/or modify it under the same terms as Perl itself.
  95
  96 =cut
  97