Log-Fast-1.0.6/0000755000175000017500000000000012223275045013376 5ustar powermanpowermanLog-Fast-1.0.6/t/0000755000175000017500000000000012223275045013641 5ustar powermanpowermanLog-Fast-1.0.6/t/raise.t0000644000175000017500000000304211476162325015135 0ustar powermanpowermanuse warnings; use strict; use Test::More; use Test::Exception; use Log::Fast; plan tests => 17; my $LOG = Log::Fast->global(); lives_ok { Log::Fast->new({}) }; lives_ok { Log::Fast->new() }; throws_ok { Log::Fast->new([]) } qr/HASHREF/; lives_ok { $LOG->config({}) }; throws_ok { $LOG->config() } qr/HASHREF/; throws_ok { $LOG->config([]) } qr/HASHREF/; lives_ok { $LOG->config({prefix=>q{}}) }; throws_ok { $LOG->config({preFix=>q{}}) } qr/unknown option/; throws_ok { $LOG->config({level=>'InFo'}) } qr/{level}/; lives_ok { $LOG->config({level=>'INFO'}) }; throws_ok { $LOG->level('InFo') } qr/{level}/; lives_ok { $LOG->level('INFO') }; SKIP: { eval { use File::Temp qw( tempfile ); use Socket; (undef, my $tempfile) = tempfile(); unlink $tempfile; socket my $sock, AF_UNIX, SOCK_DGRAM, 0 or die "socket: $!"; connect $sock, sockaddr_un($tempfile) or die "connect: $!"; unlink $tempfile; }; skip 'no UNIX sockets available', 2 if $@; SKIP: { use Sys::Syslog (); my $path = Sys::Syslog::_PATH_LOG() || '/dev/log'; skip 'unable to detect syslog socket', 1 if !-S $path; lives_ok { $LOG->config({type=>'unix',path=>$path}) }; } throws_ok { $LOG->config({type=>'unix',path=>'nosuch'}) } qr/connect:/; } throws_ok { $LOG->config({type=>'Fh',fh=>\*NOSUCH}) } qr/{type}/; lives_ok { $LOG->config({type=>'fh',fh=>\*NOSUCH}) }; throws_ok { $SIG{__WARN__}=sub{}; $LOG->ERR('test') } qr/print/; Log-Fast-1.0.6/t/syslog.t0000644000175000017500000000701211756571206015356 0ustar powermanpowermanuse warnings; use strict; use Test::More; use Socket; use Log::Fast; if ($^O =~ /Win/xms) { plan skip_all => 'not availaible on Windows'; } else { plan tests => 19; } use constant PATH => "/tmp/log.$$.sock"; socket my $Srv, AF_UNIX, SOCK_DGRAM, 0 or die "socket: $!"; bind $Srv, sockaddr_un(PATH) or die "bind: $!"; END { unlink PATH } sub _log() { sysread $Srv, my $buf, 8192 or die "sysread: $!"; return $buf } our $LOG = Log::Fast->new({ type => 'unix', path => PATH, }); my $H = qr/\A<11>\w\w\w [ \d]\d \d\d:\d\d:\d\d syslog\.t\[$$\]:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'defaults'; $LOG->config({ add_timestamp => 0, add_hostname => 0, add_pid => 0, }); $H = qr/\A<11>syslog\.t:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'minimum features'; $H = qr/\A<12>syslog\.t:/ms; $LOG->WARN('msg'); like _log, qr/$H msg\z/ms, 'levels: WARN'; $H = qr/\A<13>syslog\.t:/ms; $LOG->NOTICE('msg'); like _log, qr/$H msg\z/ms, 'levels: NOTICE'; $H = qr/\A<14>syslog\.t:/ms; $LOG->INFO('msg'); like _log, qr/$H msg\z/ms, 'levels: INFO'; $H = qr/\A<15>syslog\.t:/ms; $LOG->DEBUG('msg'); like _log, qr/$H msg\z/ms, 'levels: DEBUG'; use Sys::Syslog qw( LOG_DAEMON LOG_AUTH LOG_USER ); $LOG->config({ facility => LOG_DAEMON }); $H = qr/\A<27>syslog\.t:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'facilities: daemon'; $LOG->config({ facility => LOG_AUTH }); $H = qr/\A<35>syslog\.t:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'facilities: auth'; $LOG->config({ facility => LOG_USER }); $H = qr/\A<11>syslog\.t:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'facilities: user'; $LOG->config({ add_timestamp => 1 }); $H = qr/\A<11>\w\w\w [ \d]\d \d\d:\d\d:\d\d syslog\.t:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'feature: timestamp'; $LOG->config({ add_timestamp => 0 }); use Sys::Hostname; $LOG->config({ add_hostname => 1 }); $H = qr/\A<11>\Q${\ hostname }\E syslog\.t:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'feature: hostname (default)'; $LOG->config({ hostname => 'myhost' }); $H = qr/\A<11>myhost syslog\.t:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'feature: hostname (user-defined)'; $LOG->config({ add_hostname => 0 }); $LOG->ident('myapp'); $H = qr/\A<11>myapp:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'ident'; is $LOG->ident(), 'myapp', 'current ident without change'; is $LOG->ident('myapp2'), 'myapp', 'previous ident on change'; is $LOG->ident('myapp'), 'myapp2', 'previous ident on change'; $LOG->config({ add_pid => 1 }); $H = qr/\A<11>myapp\[$$\]:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'feature: pid (default)'; $LOG->config({ pid => 31337 }); $H = qr/\A<11>myapp\[31337\]:/ms; $LOG->ERR('msg'); like _log, qr/$H msg\z/ms, 'feature: pid (user-defined)'; $LOG->config({ add_pid => 0 }); $LOG->config({ prefix => '%S %D %T [%L]%_%P->%F %%', facility => LOG_DAEMON, add_timestamp => 1, add_hostname => 1, hostname => 'somehost', ident => 'тест', add_pid => 1, pid => 65535, }); $H = qr/\A<31>\w\w\w [ \d]\d \d\d:\d\d:\d\d somehost тест\[65535\]:/ms; my $P = qr/\d+\.\d{5} 20\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[DEBUG\] main-> %/ms; $LOG->DEBUG('сообщение'); my $msg = _log; utf8::decode($msg); like $msg, qr/$H ${P}сообщение\z/ms, 'everything (prefix, features, unicode)'; Log-Fast-1.0.6/t/a/0000755000175000017500000000000012223275045014061 5ustar powermanpowermanLog-Fast-1.0.6/t/a/b.pm0000644000175000017500000000030111471025275014634 0ustar powermanpowermanpackage a::b; use warnings; use strict; my $LOG = Log::Fast->global(); sub B { $LOG->ERR('in a::b::B'); } sub call { my $func = shift; no strict 'refs'; $func->(@_); } 1; Log-Fast-1.0.6/t/perlcritic.t0000644000175000017500000000077411470501337016175 0ustar powermanpowermanuse strict; use warnings; use Test::More; use File::Spec; if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } eval { require Test::Perl::Critic; }; plan(skip_all=>'Test::Perl::Critic required to criticise code') if $@; my $rcfile = File::Spec->catfile( 't', '.perlcriticrc' ); Test::Perl::Critic->import( -profile => $rcfile, -verbose => 9, # verbose 6 will hide rule name ); all_critic_ok(); Log-Fast-1.0.6/t/pod-coverage.t0000644000175000017500000000115411470501337016401 0ustar powermanpowermanuse strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; #all_pod_coverage_ok({ also_private => [ 'some', qr/^[A-Z_]+$/ ] }); all_pod_coverage_ok(); Log-Fast-1.0.6/t/level.t0000644000175000017500000000155411756570726015160 0ustar powermanpowermanuse warnings; use strict; use Test::More; use Log::Fast; plan tests => 9; my $LOG = Log::Fast->new(); my $BUF = q{}; open my $fh, '>', \$BUF; $LOG->config({ fh=>$fh }); sub _log() { seek $fh, 0, 0; substr $BUF, 0, length $BUF, q{} } sub logall { $LOG->ERR('E'); $LOG->WARN('W'); $LOG->NOTICE('N'); $LOG->INFO('I'); $LOG->DEBUG('D'); } logall(); is _log(), "E\nW\nN\nI\nD\n", '(default) DEBUG'; $LOG->level('INFO'); is $LOG->level(), 'INFO'; logall(); is _log(), "E\nW\nN\nI\n", 'INFO'; $LOG->config({ level=>'NOTICE' }); is $LOG->level(), 'NOTICE'; logall(); is _log(), "E\nW\nN\n", 'NOTICE'; $LOG->level('WARN'); logall(); is _log(), "E\nW\n", 'WARN'; $LOG->level('ERR'); logall(); is _log(), "E\n", 'ERR'; $LOG->level('DEBUG'); logall(); is _log(), "E\nW\nN\nI\nD\n", 'DEBUG'; is $LOG->level('INFO'), 'DEBUG', 'previous level on change'; Log-Fast-1.0.6/t/unicode.t0000644000175000017500000000150211471042212015442 0ustar powermanpowermanuse warnings; use strict; use Test::More; use Test::Exception; use Log::Fast; plan tests => 5; my $LOG = Log::Fast->new(); my $BUF = q{}; open my $fh, '>', \$BUF; $LOG->config({ fh=>$fh }); sub _log() { seek $fh, 0, 0; substr $BUF, 0, length $BUF, q{} } use utf8; $SIG{__WARN__} = sub { die $_[0] if $_[0] =~ /Wide char/ }; $LOG->config({ prefix => 'Уровень %L: ' }); lives_ok { $LOG->ERR('This is a сообщение') } 'Unicode message processed'; my $utf8 = _log(); ok !utf8::is_utf8($utf8), 'log contain bytes'; ok utf8::valid($utf8), 'the bytes form valid UTF8'; my $unicode = $utf8; ok utf8::decode($unicode), 'decoded to Unicode'; is $unicode, "Уровень ERR: This is a сообщение\n", 'message content match'; Log-Fast-1.0.6/t/manifest.t0000644000175000017500000000040111470501337015626 0ustar powermanpowermanuse strict; use warnings; use Test::More; unless ( $ENV{TEST_AUTHOR} ) { plan( skip_all => "Author tests not required for installation" ); } eval "use Test::CheckManifest 0.9"; plan skip_all => "Test::CheckManifest 0.9 required" if $@; ok_manifest(); Log-Fast-1.0.6/t/prefix.t0000644000175000017500000001063611471031057015326 0ustar powermanpowermanuse warnings; use strict; use Test::More; use Log::Fast; plan tests => 40; our $LOG = Log::Fast->global(); my $BUF = q{}; open my $fh, '>', \$BUF; $LOG->config({ fh=>$fh }); sub _log() { seek $fh, 0, 0; substr $BUF, 0, length $BUF, q{} } # empty prefix $LOG->ERR('msg'); is _log, "msg\n", $LOG->{prefix}; # static prefix $LOG->config({ prefix=>'pre' }); $LOG->ERR('msg'); is _log, "premsg\n", $LOG->{prefix}; # %L - log level of current message $LOG->config({ prefix=>'%L' }); $LOG->ERR('msg'); is _log, "ERRmsg\n", $LOG->{prefix}; $LOG->WARN('msg'); is _log, "WARNmsg\n", $LOG->{prefix}; # %S - hi-resolution time (seconds.microseconds) $LOG->config({ prefix=>'%S' }); $LOG->ERR('msg'); like _log, qr/\A\d+\.\d{5}msg\n\z/xms, $LOG->{prefix}; # %D - current date in format YYYY-MM-DD $LOG->config({ prefix=>'%D' }); $LOG->ERR('msg'); like _log, qr/\A20\d\d-\d\d-\d\dmsg\n\z/xms, $LOG->{prefix}; # %T - current time in format HH:MM:SS $LOG->config({ prefix=>'%T' }); $LOG->ERR('msg'); like _log, qr/\A\d\d:\d\d:\d\dmsg\n\z/xms, $LOG->{prefix}; # %P - caller's function package ('main' or 'My::Module') $LOG->config({ prefix=>'%P' }); $LOG->ERR('msg'); is _log, "mainmsg\n", $LOG->{prefix}; # %F - caller's function name $LOG->config({ prefix=>'%F' }); $LOG->ERR('msg'); is _log, "msg\n", $LOG->{prefix}; # %_ - X spaces, where X is current stack depth $LOG->config({ prefix=>'%_' }); $LOG->ERR('msg'); is _log, " msg\n", $LOG->{prefix}; # %% - % character $LOG->config({ prefix=>'%%' }); $LOG->ERR('msg'); is _log, "%msg\n", $LOG->{prefix}; # all prefixes $LOG->config({ prefix=>'%S %D %T [%L]%_%P::%F %% ' }); $LOG->ERR('msg'); like _log, qr/\A\d+\.\d{5} 20\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[ERR\] main:: % msg\n\z/ms, $LOG->{prefix}; # all prefixes, twice $LOG->config({ prefix=>'%S %D %T [%L]%_%P::%F %% 'x2 }); $LOG->ERR('msg'); like _log, qr/\A(\d+\.\d{5} 20\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[ERR\] main:: % ){2}msg\n\z/ms, $LOG->{prefix}; ### # stack/package/function ### $LOG->config({ prefix=>'%_%P->%F ' }); # from main script $LOG->ERR('in script'); is _log, " main-> in script\n", 'script'; eval { $LOG->ERR('in script') }; is _log, " main->(eval) in script\n", 'script eval {}'; eval '$LOG->ERR("in script");'; is _log, " main->(eval) in script\n", 'script eval ""'; # from main::sub sub M { $LOG->ERR('in M') } M(); is _log, " main->M in M\n", 'M'; eval { M() }; is _log, " main->M in M\n", 'eval {M}'; eval 'M()'; is _log, " main->M in M\n", 'eval "M"'; sub MEB { eval { $LOG->ERR('in MEB') } }; sub MES { eval ' $LOG->ERR("in MES") ' }; MEB(); is _log, " main->(eval) in MEB\n", 'MEB'; MES(); is _log, " main->(eval) in MES\n", 'MES'; # from a::A use lib 't'; use a; a::A(); is _log, " a->A in a::A\n", 'a::A'; a::call('a::A'); is _log, " a->A in a::A\n", 'a::call->a::A'; a::call('a::call', 'a::A'); is _log, " a->A in a::A\n", 'a::call->a::call->a::A'; # from a::b::B use a::b; a::b::B(); is _log, " a::b->B in a::b::B\n", 'a::b::B'; a::b::call('a::b::B'); is _log, " a::b->B in a::b::B\n", 'a::b::call->a::b::B'; a::call('a::b::B'); is _log, " a::b->B in a::b::B\n", 'a::call->a::b::B'; a::b::call('a::call', 'a::b::B'); is _log, " a::b->B in a::b::B\n", 'a::b::call->a::call->a::b::B'; # from injected a::b::Fx sub a::b::F1 { $LOG->ERR('in a::b::F1') } *a::b::F2 = sub { $LOG->ERR('in a::b::F2') }; *a::b::F3 = eval 'sub { $LOG->ERR("in a::b::F3") };'; eval 'sub a::b::F4 { $LOG->ERR("in a::b::F4") };'; eval 'package a::b; sub F5 { $LOG->ERR("in a::b::F5") };'; package a::b; sub F6 { $LOG->ERR("in a::b::F6") }; package main; a::b::F1(); is _log, " main->F1 in a::b::F1\n", 'a::b::F1'; a::b::F2(); is _log, " main->__ANON__ in a::b::F2\n", 'a::b::F2'; a::b::F3(); is _log, " main->__ANON__ in a::b::F3\n", 'a::b::F3'; a::b::F4(); is _log, " main->F4 in a::b::F4\n", 'a::b::F4'; a::b::F5(); is _log, " a::b->F5 in a::b::F5\n", 'a::b::F5'; a::b::F6(); is _log, " a::b->F6 in a::b::F6\n", 'a::b::F6'; # from injected a::b::Fx with 1 additional stack a::call('a::b::F1'); is _log, " main->F1 in a::b::F1\n", 'a::b::F1 plus 1 stack'; a::call('a::b::F2'); is _log, " main->__ANON__ in a::b::F2\n", 'a::b::F2 plus 1 stack'; a::call('a::b::F3'); is _log, " main->__ANON__ in a::b::F3\n", 'a::b::F3 plus 1 stack'; a::call('a::b::F4'); is _log, " main->F4 in a::b::F4\n", 'a::b::F4 plus 1 stack'; a::call('a::b::F5'); is _log, " a::b->F5 in a::b::F5\n", 'a::b::F5 plus 1 stack'; a::call('a::b::F6'); is _log, " a::b->F6 in a::b::F6\n", 'a::b::F6 plus 1 stack'; Log-Fast-1.0.6/t/00.load.t0000644000175000017500000000027311470501337015164 0ustar powermanpowermanuse warnings; use strict; use Test::More tests => 1; BEGIN { use_ok( 'Log::Fast' ) or BAIL_OUT('unable to load module') } diag( "Testing Log::Fast $Log::Fast::VERSION, Perl $], $^X" ); Log-Fast-1.0.6/t/pod.t0000644000175000017500000000033511470501337014610 0ustar powermanpowermanuse strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Log-Fast-1.0.6/t/global.t0000644000175000017500000000062011471031142015254 0ustar powermanpowermanuse warnings; use strict; use Test::More; use Log::Fast; plan tests => 4; my $LOG = Log::Fast->global(); like ref $LOG, qr/\ALog::Fast::_\d+\z/, 'global created'; is $LOG, Log::Fast->global(), 'global is same'; like ref Log::Fast->new(), qr/\ALog::Fast::_\d+\z/, 'local created'; isnt $LOG, Log::Fast->new(), 'global differ from local'; Log-Fast-1.0.6/t/a.pm0000644000175000017500000000027311471025267014424 0ustar powermanpowermanpackage a; use warnings; use strict; my $LOG = Log::Fast->global(); sub A { $LOG->ERR('in a::A'); } sub call { my $func = shift; no strict 'refs'; $func->(@_); } 1; Log-Fast-1.0.6/t/.perlcriticrc0000644000175000017500000012310612137707023016332 0ustar powermanpowerman# Globals # severity = 5 severity = 1 # force = 0 # only = 0 # profile-strictness = warn # color = 0 # pager = # top = 0 # verbose = 4 #verbose = 11 verbose = 2 # include = # exclude = # single-policy = # theme = # Use `List::MoreUtils::any' instead of `grep' in boolean context. [-BuiltinFunctions::ProhibitBooleanGrep] # set_themes = core pbp performance # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Map blocks should have a single statement. [BuiltinFunctions::ProhibitComplexMappings] # set_themes = complexity core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The maximum number of statements to allow within a map block. # Minimum value 1. No maximum. # max_statements = 1 # Use 4-argument `substr' instead of writing `substr($foo, 2, 6) = $bar'. [BuiltinFunctions::ProhibitLvalueSubstr] # set_themes = core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Forbid $b before $a in sort blocks. [BuiltinFunctions::ProhibitReverseSortBlock] # set_themes = core cosmetic pbp # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # Use Time::HiRes instead of something like `select(undef, undef, undef, .05)'. [BuiltinFunctions::ProhibitSleepViaSelect] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Write `eval { my $foo; bar($foo) }' instead of `eval "my $foo; bar($foo);"'. [BuiltinFunctions::ProhibitStringyEval] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Write `split /-/, $string' instead of `split '-', $string'. [BuiltinFunctions::ProhibitStringySplit] # set_themes = core cosmetic pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Write `eval { $foo->can($name) }' instead of `UNIVERSAL::can($foo, $name)'. [BuiltinFunctions::ProhibitUniversalCan] # set_themes = core maintenance # add_themes = # severity = 3 severity = 4 # maximum_violations_per_document = no_limit # Write `eval { $foo->isa($pkg) }' instead of `UNIVERSAL::isa($foo, $pkg)'. [BuiltinFunctions::ProhibitUniversalIsa] # set_themes = core maintenance # add_themes = # severity = 3 severity = 4 # maximum_violations_per_document = no_limit # Don't use `grep' in void contexts. [BuiltinFunctions::ProhibitVoidGrep] # set_themes = core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Don't use `map' in void contexts. [BuiltinFunctions::ProhibitVoidMap] # set_themes = core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Write `grep { $_ =~ /$pattern/ } @list' instead of `grep /$pattern/, @list'. [BuiltinFunctions::RequireBlockGrep] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Write `map { $_ =~ /$pattern/ } @list' instead of `map /$pattern/, @list'. [BuiltinFunctions::RequireBlockMap] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Use `glob q{*}' instead of <*>. [BuiltinFunctions::RequireGlobFunction] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Sort blocks should have a single statement. [BuiltinFunctions::RequireSimpleSortBlock] # set_themes = complexity core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # AUTOLOAD methods should be avoided. [ClassHierarchies::ProhibitAutoloading] # set_themes = core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Employ `use base' instead of `@ISA'. [ClassHierarchies::ProhibitExplicitISA] # set_themes = core maintenance pbp # add_themes = # severity = 3 severity = 4 # maximum_violations_per_document = no_limit # Write `bless {}, $class;' instead of just `bless {};'. [ClassHierarchies::ProhibitOneArgBless] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Use spaces instead of tabs. [CodeLayout::ProhibitHardTabs] # set_themes = core cosmetic # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Allow hard tabs before first non-whitespace character. # allow_leading_tabs = 1 # Write `open $handle, $path' instead of `open($handle, $path)'. [CodeLayout::ProhibitParensWithBuiltins] # set_themes = core cosmetic pbp # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # Write `qw(foo bar baz)' instead of `('foo', 'bar', 'baz')'. [CodeLayout::ProhibitQuotedWordLists] # set_themes = core cosmetic # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # The minimum number of words in a list that will be complained about. # Minimum value 1. No maximum. # min_elements = 2 # Complain even if there are non-word characters in the values. # strict = 0 # Don't use whitespace at the end of lines. [CodeLayout::ProhibitTrailingWhitespace] # set_themes = core maintenance # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # Use the same newline through the source. [CodeLayout::RequireConsistentNewlines] # set_themes = bugs core # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Put a comma at the end of every multi-line list declaration, including the last one. [CodeLayout::RequireTrailingCommas] # set_themes = core cosmetic pbp # add_themes = # severity = 1 severity = 3 # maximum_violations_per_document = no_limit [-CodeLayout::RequireTidyCode] # Write `for(0..20)' instead of `for($i=0; $i<=20; $i++)'. [-ControlStructures::ProhibitCStyleForLoops] # set_themes = core maintenance pbp # add_themes = # severity = 2 severity = 3 # maximum_violations_per_document = no_limit # Don't write long "if-elsif-elsif-elsif-elsif...else" chains. [ControlStructures::ProhibitCascadingIfElse] # set_themes = complexity core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The maximum number of alternatives that will be allowed. # Minimum value 1. No maximum. # max_elsif = 2 # Don't write deeply nested loops and conditionals. [ControlStructures::ProhibitDeepNests] # set_themes = complexity core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The maximum number of nested constructs to allow. # Minimum value 1. No maximum. # max_nests = 5 # Don't use labels that are the same as the special block names. [ControlStructures::ProhibitLabelsWithSpecialBlockNames] # set_themes = bugs core # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Don't modify `$_' in list functions. [ControlStructures::ProhibitMutatingListFunctions] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # The base set of functions to check. # list_funcs = map grep List::Util::first List::MoreUtils::any List::MoreUtils::all List::MoreUtils::none List::MoreUtils::notall List::MoreUtils::true List::MoreUtils::false List::MoreUtils::firstidx List::MoreUtils::first_index List::MoreUtils::lastidx List::MoreUtils::last_index List::MoreUtils::insert_after List::MoreUtils::insert_after_string # The set of functions to check, in addition to those given in list_funcs. # add_list_funcs = # Don't use operators like `not', `!~', and `le' within `until' and `unless'. [ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions] # set_themes = core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Write `if($condition){ do_something() }' instead of `do_something() if $condition'. [ControlStructures::ProhibitPostfixControls] # set_themes = core cosmetic pbp # add_themes = # severity = 2 severity = 4 # maximum_violations_per_document = no_limit # The permitted postfix controls. # Valid values: for, foreach, if, unless, until, while. # allow = # The exempt flow control functions. # flowcontrol = carp cluck confess croak die exit goto warn # Write `if(! $condition)' instead of `unless($condition)'. [ControlStructures::ProhibitUnlessBlocks] # set_themes = core cosmetic pbp # add_themes = # severity = 2 severity = 4 # maximum_violations_per_document = no_limit # Don't write code after an unconditional `die, exit, or next'. [ControlStructures::ProhibitUnreachableCode] # set_themes = bugs core # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Write `while(! $condition)' instead of `until($condition)'. [ControlStructures::ProhibitUntilBlocks] # set_themes = core cosmetic pbp # add_themes = # severity = 2 severity = 4 # maximum_violations_per_document = no_limit [-Documentation::PodSpelling] spell_command = aspell list -l en # The `=head1 NAME' section should match the package. [Documentation::RequirePackageMatchesPodName] # set_themes = core cosmetic # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # All POD should be after `__END__'. [Documentation::RequirePodAtEnd] # set_themes = core cosmetic pbp # add_themes = # severity = 1 severity = 2 # maximum_violations_per_document = no_limit # Organize your POD into the customary sections. [-Documentation::RequirePodSections] # set_themes = core maintenance pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # The sections to require for modules (separated by qr/\s* [|] \s*/xms). # lib_sections = # The sections to require for programs (separated by qr/\s* [|] \s*/xms). # script_sections = # The origin of sections to use. # Valid values: book, book_first_edition, module_starter_pbp, module_starter_pbp_0_0_3. # source = book_first_edition source = module_starter_pbp_0_0_3 # The spelling of sections to use. # Valid values: en_AU, en_US. # language = language = en_US [-Documentation::RequirePodLinksIncludeText] # Use functions from Carp instead of `warn' or `die'. [ErrorHandling::RequireCarping] # set_themes = core maintenance pbp # add_themes = # severity = 3 severity = 4 # maximum_violations_per_document = no_limit # Don't complain about die or warn if the message ends in a newline. # allow_messages_ending_with_newlines = 1 # You can't depend upon the value of `$@'/`$EVAL_ERROR' to tell whether an `eval' failed. [ErrorHandling::RequireCheckingReturnValueOfEval] # set_themes = bugs core # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Discourage stuff like `@files = `ls $directory`'. [-InputOutput::ProhibitBacktickOperators] # set_themes = core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Allow backticks everywhere except in void contexts. # only_in_void_context = # Write `open my $fh, q{<}, $filename;' instead of `open FH, q{<}, $filename;'. [InputOutput::ProhibitBarewordFileHandles] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Use "<>" or "" or a prompting module instead of "". [InputOutput::ProhibitExplicitStdin] # set_themes = core maintenance pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Use prompt() instead of -t. [InputOutput::ProhibitInteractiveTest] # set_themes = bugs core pbp # add_themes = # severity = 5 severity = 4 # maximum_violations_per_document = no_limit # Use `local $/ = undef' or File::Slurp instead of joined readline. [InputOutput::ProhibitJoinedReadline] # set_themes = core pbp performance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Never write `select($fh)'. [InputOutput::ProhibitOneArgSelect] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Write `while( $line = <> ){...}' instead of `for(<>){...}'. [InputOutput::ProhibitReadlineInForLoop] # set_themes = bugs core pbp # add_themes = # severity = 4 severity = 5 # maximum_violations_per_document = no_limit # Write `open $fh, q{<}, $filename;' instead of `open $fh, "<$filename";'. [InputOutput::ProhibitTwoArgOpen] # set_themes = bugs core pbp security # add_themes = # severity = 5 severity = 4 # maximum_violations_per_document = no_limit # Write `print {$FH} $foo, $bar;' instead of `print $FH $foo, $bar;'. [InputOutput::RequireBracedFileHandleWithPrint] # set_themes = core cosmetic pbp # add_themes = # severity = 1 severity = 3 # maximum_violations_per_document = no_limit # Close filehandles as soon as possible after opening them. [InputOutput::RequireBriefOpen] # set_themes = core maintenance pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # The maximum number of lines between an open() and a close(). # Minimum value 1. No maximum. # lines = 9 # Write `my $error = close $fh;' instead of `close $fh;'. [InputOutput::RequireCheckedClose] # set_themes = core maintenance # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Write `my $error = open $fh, $mode, $filename;' instead of `open $fh, $mode, $filename;'. [InputOutput::RequireCheckedOpen] # set_themes = core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Return value of flagged function ignored. [InputOutput::RequireCheckedSyscalls] # set_themes = core maintenance # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # The set of functions to require checking the return value of. # functions = open close print functions = open close # Do not use `format'. [Miscellanea::ProhibitFormats] # set_themes = core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Do not use `tie'. [Miscellanea::ProhibitTies] # set_themes = core maintenance pbp # add_themes = # severity = 2 severity = 4 # maximum_violations_per_document = no_limit [-Miscellanea::ProhibitUnrestrictedNoCritic] # Export symbols via `@EXPORT_OK' or `%EXPORT_TAGS' instead of `@EXPORT'. [Modules::ProhibitAutomaticExportation] # set_themes = bugs core # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Ban modules that aren't blessed by your shop. [Modules::ProhibitEvilModules] # set_themes = bugs core # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # The names of or patterns for modules to forbid. # modules = # Minimize complexity in code that is outside of subroutines. [Modules::ProhibitExcessMainComplexity] # set_themes = complexity core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The maximum complexity score allowed. # Minimum value 1. No maximum. # max_mccabe = 20 # Put packages (especially subclasses) in separate files. [Modules::ProhibitMultiplePackages] # set_themes = bugs core # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Write `require Module' instead of `require 'Module.pm''. [Modules::RequireBarewordIncludes] # set_themes = core portability # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # End each module with an explicitly `1;' instead of some funky expression. [Modules::RequireEndWithOne] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Always make the `package' explicit. [Modules::RequireExplicitPackage] # set_themes = bugs core # add_themes = # severity = 4 # maximum_violations_per_document = 1 # Don't require programs to contain a package statement. # exempt_scripts = 1 # Package declaration must match filename. [Modules::RequireFilenameMatchesPackage] # set_themes = bugs core # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # `use English' must be passed a `-no_match_vars' argument. [Modules::RequireNoMatchVarsWithUseEnglish] # set_themes = core performance # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Give every module a `$VERSION' number. [Modules::RequireVersionVar] # set_themes = core pbp readability # add_themes = # severity = 2 severity = 4 # maximum_violations_per_document = no_limit # Don't use vague variable or subroutine names like 'last' or 'record'. [NamingConventions::ProhibitAmbiguousNames] # set_themes = core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The variable names that are not to be allowed. # forbid = abstract bases close contract last left no record right second set [NamingConventions::Capitalization] file_lexical_variables = :no_restriction # Write `@{ $array_ref }' instead of `@$array_ref'. [References::ProhibitDoubleSigils] # set_themes = core cosmetic pbp # add_themes = # severity = 2 severity = 4 # maximum_violations_per_document = no_limit # Capture variable used outside conditional. [-RegularExpressions::ProhibitCaptureWithoutTest] # set_themes = core maintenance pbp # add_themes = # severity = 3 severity = 4 # maximum_violations_per_document = no_limit # Split long regexps into smaller `qr//' chunks. [RegularExpressions::ProhibitComplexRegexes] # set_themes = core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The maximum number of characters to allow in a regular expression. # Minimum value 1. No maximum. # max_characters = 60 # Use named character classes instead of explicit character lists. [RegularExpressions::ProhibitEnumeratedClasses] # set_themes = core cosmetic pbp unicode # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # Use character classes for literal meta-characters instead of escapes. [RegularExpressions::ProhibitEscapedMetacharacters] # set_themes = core cosmetic pbp # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # Use `eq' or hash instead of fixed-pattern regexps. [RegularExpressions::ProhibitFixedStringMatches] # set_themes = core pbp performance # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Use `[abc]' instead of `a|b|c'. [RegularExpressions::ProhibitSingleCharAlternation] # set_themes = core pbp performance # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # Only use a capturing group if you plan to use the captured value. [RegularExpressions::ProhibitUnusedCapture] # set_themes = core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Use only `//' or `{}' to delimit regexps. [RegularExpressions::ProhibitUnusualDelimiters] # set_themes = core cosmetic pbp # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # In addition to allowing '{}', allow '()', '[]', and '{}'. # allow_all_brackets = # Use `{' and `}' to delimit multi-line regexps. [RegularExpressions::RequireBracesForMultiline] # set_themes = core cosmetic pbp # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # In addition to allowing '{}', allow '()', '[]', and '{}'. # allow_all_brackets = # Always use the `/s' modifier with regular expressions. [RegularExpressions::RequireDotMatchAnything] # set_themes = core cosmetic pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Always use the `/x' modifier with regular expressions. [-RegularExpressions::RequireExtendedFormatting] # set_themes = core maintenance pbp # add_themes = # severity = 3 severity = 5 # maximum_violations_per_document = no_limit # The number of characters that a regular expression must contain before this policy will complain. # Minimum value 0. No maximum. # minimum_regex_length_to_complain_about = 0 # Should regexes that only contain whitespace and word characters be complained about?. # strict = 0 # Always use the `/m' modifier with regular expressions. [RegularExpressions::RequireLineBoundaryMatching] # set_themes = core cosmetic pbp # add_themes = # severity = 2 severity = 5 # maximum_violations_per_document = no_limit # Don't call functions with a leading ampersand sigil. [Subroutines::ProhibitAmpersandSigils] # set_themes = core maintenance pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Don't declare your own `open' function. [Subroutines::ProhibitBuiltinHomonyms] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Minimize complexity by factoring code into smaller subroutines. [Subroutines::ProhibitExcessComplexity] # set_themes = complexity core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The maximum complexity score allowed. # Minimum value 1. No maximum. # max_mccabe = 20 # Return failure with bare `return' instead of `return undef'. [Subroutines::ProhibitExplicitReturnUndef] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Too many arguments. [Subroutines::ProhibitManyArgs] # set_themes = core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The maximum number of arguments to allow a subroutine to have. # Minimum value 1. No maximum. # max_arguments = 5 # `sub never { sub correct {} }'. [Subroutines::ProhibitNestedSubs] # set_themes = bugs core # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Don't write `sub my_function (@@) {}'. [Subroutines::ProhibitSubroutinePrototypes] # set_themes = bugs core pbp # add_themes = # severity = 5 severity = 4 # maximum_violations_per_document = no_limit # Prevent access to private subs in other packages. [Subroutines::ProtectPrivateSubs] # set_themes = core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Always unpack `@_' first. [Subroutines::RequireArgUnpacking] # set_themes = core maintenance pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # The number of statements to allow without unpacking. # Minimum value 0. No maximum. # short_subroutine_statements = 0 # End every path through a subroutine with an explicit `return' statement. [Subroutines::RequireFinalReturn] # set_themes = bugs core pbp # add_themes = # severity = 4 severity = 5 # maximum_violations_per_document = no_limit # The additional subroutines to treat as terminal. # Values that are always included: Carp::confess, Carp::croak, confess, croak, die, exec, exit, throw. # terminal_funcs = # Prohibit various flavors of `no strict'. [TestingAndDebugging::ProhibitNoStrict] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Allow vars, subs, and/or refs. # allow = allow = refs # Prohibit various flavors of `no warnings'. [TestingAndDebugging::ProhibitNoWarnings] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Permitted warning categories. # allow = # Allow "no warnings" if it restricts the kinds of warnings that are turned off. # allow_with_category_restriction = 0 # Don't turn off strict for large blocks of code. [TestingAndDebugging::ProhibitProlongedStrictureOverride] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # The maximum number of statements in a no strict block. # Minimum value 1. No maximum. # statements = 3 # Tests should all have labels. [TestingAndDebugging::RequireTestLabels] # set_themes = core maintenance tests # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The additional modules to require labels for. # Values that are always included: Test::More. # modules = # Always `use strict'. [TestingAndDebugging::RequireUseStrict] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = 1 # Always `use warnings'. [TestingAndDebugging::RequireUseWarnings] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = 1 # Don't use the comma operator as a statement separator. [ValuesAndExpressions::ProhibitCommaSeparatedStatements] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Allow map and grep blocks to return lists. # allow_last_statement_to_be_comma_separated_in_map_and_grep = 0 # Don't `use constant $FOO => 15'. [-ValuesAndExpressions::ProhibitConstantPragma] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Write `q{}' instead of `'''. [ValuesAndExpressions::ProhibitEmptyQuotes] # set_themes = core cosmetic pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Write `"\N{DELETE}"' instead of `"\x7F"', etc. [ValuesAndExpressions::ProhibitEscapedCharacters] # set_themes = core cosmetic pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Use concatenation or HEREDOCs instead of literal line breaks in strings. [ValuesAndExpressions::ProhibitImplicitNewlines] # set_themes = core cosmetic pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Always use single quotes for literal strings. [ValuesAndExpressions::ProhibitInterpolationOfLiterals] # set_themes = core cosmetic pbp # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # Kinds of delimiters to permit, e.g. "qq{", "qq(", "qq[", "qq/". # allow = # If the string contains ' characters, allow "" to quote it. # allow_if_string_contains_single_quote = 0 # Write `oct(755)' instead of `0755'. [ValuesAndExpressions::ProhibitLeadingZeros] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Don't allow any leading zeros at all. Otherwise builtins that deal with Unix permissions, e.g. chmod, don't get flagged. # strict = 0 # Long chains of method calls indicate tightly coupled code. [ValuesAndExpressions::ProhibitLongChainsOfMethodCalls] # set_themes = core maintenance # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # The number of chained calls to allow. # Minimum value 1. No maximum. # max_chain_length = 3 # Don't use values that don't explain themselves. [ValuesAndExpressions::ProhibitMagicNumbers] # set_themes = core maintenance # add_themes = # severity = 2 # maximum_violations_per_document = 10 # Individual and ranges of values to allow, and/or "all_integers". # allowed_values = 0 1 2 # Kind of literals to allow. # Valid values: Binary, Exp, Float, Hex, Octal. # allowed_types = Float # Don't mix numeric operators with string operands, or vice-versa. [ValuesAndExpressions::ProhibitMismatchedOperators] # set_themes = bugs core # add_themes = # severity = 3 severity = 2 # maximum_violations_per_document = no_limit # Write ` !$foo && $bar || $baz ' instead of ` not $foo && $bar or $baz'. [ValuesAndExpressions::ProhibitMixedBooleanOperators] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Use `q{}' or `qq{}' instead of quotes for awkward-looking strings. [ValuesAndExpressions::ProhibitNoisyQuotes] # set_themes = core cosmetic pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Don't use quotes (`'', `"', ``') as delimiters for the quote-like operators. [ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters] # set_themes = core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The operators to allow single-quotes as delimiters for. # Valid values: m, q, qq, qr, qw, qx, s, tr, y. # single_quote_allowed_operators = m s qr qx # The operators to allow double-quotes as delimiters for. # Valid values: m, q, qq, qr, qw, qx, s, tr, y. # double_quote_allowed_operators = # The operators to allow back-quotes (back-ticks) as delimiters for. # Valid values: m, q, qq, qr, qw, qx, s, tr, y. # back_quote_allowed_operators = # Don't use strings like `v1.4' or `1.4.5' when including other modules. [ValuesAndExpressions::ProhibitVersionStrings] # set_themes = core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit [-ValuesAndExpressions::RequireConstantVersion] # Warns that you might have used single quotes when you really wanted double-quotes. [-ValuesAndExpressions::RequireInterpolationOfMetachars] # set_themes = core cosmetic pbp # add_themes = # severity = 1 # maximum_violations_per_document = no_limit # RCS keywords to ignore in potential interpolation. # rcs_keywords = # Write ` 141_234_397.0145 ' instead of ` 141234397.0145 '. [-ValuesAndExpressions::RequireNumberSeparators] # set_themes = core cosmetic pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # The minimum absolute value to require separators in. # Minimum value 10. No maximum. # min_value = 10_000 # Write ` print <<'THE_END' ' or ` print <<"THE_END" '. [ValuesAndExpressions::RequireQuotedHeredocTerminator] # set_themes = core maintenance pbp # add_themes = # severity = 3 severity = 4 # maximum_violations_per_document = no_limit # Write ` <<'THE_END'; ' instead of ` <<'theEnd'; '. [ValuesAndExpressions::RequireUpperCaseHeredocTerminator] # set_themes = core cosmetic pbp # add_themes = # severity = 2 severity = 4 # maximum_violations_per_document = no_limit # Do not write ` my $foo = $bar if $baz; '. [Variables::ProhibitConditionalDeclarations] # set_themes = bugs core # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Use `my' instead of `local', except when you have to. [Variables::ProhibitLocalVars] # set_themes = core maintenance pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Avoid `$`', `$&', `$'' and their English equivalents. [Variables::ProhibitMatchVars] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Eliminate globals declared with `our' or `use vars'. [-Variables::ProhibitPackageVars] # set_themes = core maintenance pbp # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # The base set of packages to allow variables for. # packages = File::Find Data::Dumper # The set of packages to allow variables for, in addition to those given in "packages". # add_packages = add_packages = Exporter # Use double colon (::) to separate package name components instead of single quotes ('). [Variables::ProhibitPerl4PackageNames] # set_themes = core maintenance # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # Write `$EVAL_ERROR' instead of `$@'. [-Variables::ProhibitPunctuationVars] # set_themes = core cosmetic pbp # add_themes = # severity = 2 # maximum_violations_per_document = no_limit # The additional variables to allow. # Values that are always included: $1, $2, $3, $4, $5, $6, $7, $8, $9, $_, @_, _. # allow = [Variables::ProhibitReusedNames] allow = $this $self $c # Don't ask for storage you don't need. [Variables::ProhibitUnusedVariables] # set_themes = core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Prevent access to private vars in other packages. [Variables::ProtectPrivateVars] # set_themes = core maintenance # add_themes = # severity = 3 # maximum_violations_per_document = no_limit # Write `local $foo = $bar;' instead of just `local $foo;'. [-Variables::RequireInitializationForLocalVars] # set_themes = bugs core pbp # add_themes = # severity = 3 severity = 5 # maximum_violations_per_document = no_limit # Write `for my $element (@list) {...}' instead of `for $element (@list) {...}'. [Variables::RequireLexicalLoopIterators] # set_themes = bugs core pbp # add_themes = # severity = 5 # maximum_violations_per_document = no_limit # Magic variables should be assigned as "local". [Variables::RequireLocalizedPunctuationVars] # set_themes = bugs core pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit # Negative array index should be used. [Variables::RequireNegativeIndices] # set_themes = core maintenance pbp # add_themes = # severity = 4 # maximum_violations_per_document = no_limit Log-Fast-1.0.6/MANIFEST0000644000175000017500000000105612223274770014535 0ustar powermanpowermanChanges inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Log/Fast.pm Makefile.PL MANIFEST This list of files META.yml README t/.perlcriticrc t/00.load.t t/a.pm t/a/b.pm t/global.t t/level.t t/manifest.t t/perlcritic.t t/pod-coverage.t t/pod.t t/prefix.t t/raise.t t/syslog.t t/unicode.t Log-Fast-1.0.6/META.yml0000644000175000017500000000135312223275037014652 0ustar powermanpowerman--- abstract: 'Fast and flexible logger' author: - 'Alex Efros C<< >>' build_requires: ExtUtils::MakeMaker: 6.59 Test::Exception: 0 Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: mit meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Log-Fast no_index: directory: - inc - t recommends: Pod::Coverage: 0.18 Test::CheckManifest: 0.9 Test::Perl::Critic: 0 Test::Pod: 1.22 Test::Pod::Coverage: 1.08 requires: Sys::Syslog: 0.29 perl: 5.8.0 version: 0 resources: license: http://opensource.org/licenses/mit-license.php version: 1.000006 Log-Fast-1.0.6/lib/0000755000175000017500000000000012223275045014144 5ustar powermanpowermanLog-Fast-1.0.6/lib/Log/0000755000175000017500000000000012223275045014665 5ustar powermanpowermanLog-Fast-1.0.6/lib/Log/Fast.pm0000644000175000017500000004736112223275024016130 0ustar powermanpowerman# Implemented optimizations: # * log-method's (ERR(), WARN(), etc.) implementation generated # individually for each log-object (depending on it configuration) # to include only minimum necessary code to do it work # - each time log-object configuration changes (by calling config()) # log-method's implementation re-generated to comply new configuration # - different log-objects may have different configuration and so will # need different implementation for same log-methods - so we have to # use unique package/class for each log-object (with class names looks # like 'Log::Fast::_12345678') - these classes will implement only # log-methods and inherit everything else from parent class (Log::Fast) # * implementation for log-methods inactive on current log level replaced # by empty 'sub{}' # - each time log level changes (by calling config() or level()) # implementation of all log-methods updated according to current # log level and set either to real implementation or empty 'sub{}' # * if prefixes %D and/or %T are used, then cache will be used to store # formatted date/time to avoid calculating it often than once per second # * when logging to syslog, packet header (which may contain: # log level, facility, timestamp, hostname, ident and pid) will be cached # (one cached header per each log level) # - if {add_timestamp} is true, then cached header will be used only for # one second and then recalculated # - if user change {ident} (by calling config() or ident()) cached # headers will be recalculated # * if log-methods will be called with single param sprintf() won't be used package Log::Fast; use warnings; use strict; use Carp; use 5.008; use version; our $VERSION = qv('1.0.6'); # REMINDER: update Changes # REMINDER: update dependencies in Makefile.PL use Scalar::Util qw( refaddr ); use Socket; use Sys::Hostname (); use Time::HiRes (); use Sys::Syslog (); # for _PATH_LOG() # from RFC3164 use constant LOG_USER => 1*8; use constant LOG_ERR => 3; use constant LOG_WARNING => 4; use constant LOG_NOTICE => 5; use constant LOG_INFO => 6; use constant LOG_DEBUG => 7; use constant PRI => { ERR => LOG_ERR, WARN => LOG_WARNING, NOTICE => LOG_NOTICE, INFO => LOG_INFO, DEBUG => LOG_DEBUG, }; use constant DEFAULTS => { level => 'DEBUG', prefix => q{}, type => 'fh', # used only when {type}='fh': fh => \*STDERR, # used only when {type}='unix': path => Sys::Syslog::_PATH_LOG() || '/dev/log', ## no critic(ProtectPrivateSubs) facility => LOG_USER, add_timestamp => 1, add_hostname => 0, hostname => Sys::Hostname::hostname(), ident => do { my $s = $0; utf8::decode($s); $s =~ s{\A.*/(?=.)}{}xms; $s }, add_pid => 1, pid => $$, }; my $GLOBAL; sub new { my ($class, $opt) = @_; $opt ||= {}; croak 'options must be HASHREF' if ref $opt ne 'HASH'; my $self = { # will also contain all keys defined in DEFAULTS constant # used only when {type}='unix': _sock => undef, # socket to {path} _header_ERR => q{}, # cached "TIMESTAMP IDENT[PID]: " _header_WARN => q{}, # --"-- _header_NOTICE => q{}, # --"-- _header_INFO => q{}, # --"-- _header_DEBUG => q{}, # --"-- _header_time => 0, # last update time for {_header_*} # used only if {prefix} contain %D or %T: _date => q{}, # cached "YYYY-MM-DD" _time => q{}, # cached "HH:MM:SS" _dt_time => 0, # last update time for {_date} and {_time} }; my $sub_class = $class . '::_' . refaddr($self); { no strict 'refs'; @{$sub_class.'::ISA'} = ( $class ); } bless $self, $sub_class; $self->config({ %{ DEFAULTS() }, %{ $opt } }); ## no critic return $self; } sub global { my $class = shift; $GLOBAL ||= $class->new(); return $GLOBAL; } sub config { my ($self, $opt) = @_; croak 'options must be HASHREF' if ref $opt ne 'HASH'; for my $key (keys %{ $opt }) { if (!exists DEFAULTS->{ $key }) { croak 'unknown option: '.$key; } $self->{ $key } = $opt->{ $key }; } $self->_generate_methods(); if ($self->{type} eq 'unix') { $self->_connect_unix(); $self->ident($self->{ident}); } $self->level($self->{level}); return; } sub level { my ($self, $level) = @_; my $prev_level = $self->{level}; if (defined $level) { if (!exists PRI->{$level}) { croak '{level} must be one of: '.join ', ', keys %{ PRI() }; } $self->{level} = $level; $self->_setup_level(); } return $prev_level; } sub ident { my ($self, $ident) = @_; my $prev_ident = $self->{ident}; if (defined $ident) { $self->{ident} = $ident; $self->_update_header(); } return $prev_ident; } ### Internal sub _connect_unix { my ($self) = @_; socket $self->{_sock}, AF_UNIX, SOCK_DGRAM, 0 or croak "socket: $!"; connect $self->{_sock}, sockaddr_un($self->{path}) or croak "connect: $!"; return; } sub _update_header { my ($self) = @_; my $h = q{}; if ($self->{add_timestamp}) { $self->{_header_time} = time; $h .= substr localtime $self->{_header_time}, 4, 16; ## no critic(ProhibitMagicNumbers) } if ($self->{add_hostname}) { $h .= $self->{hostname} . q{ }; } my $ident_utf8 = $self->{ident}; utf8::encode($ident_utf8); $h .= $ident_utf8; if ($self->{add_pid}) { $h .= '[' . $self->{pid} . ']'; } $h .= ': '; for my $level (keys %{ PRI() }) { $self->{'_header_'.$level} = '<' . ($self->{facility} + PRI->{$level}) . '>' . $h; } return; } sub _setup_level { my ($self) = @_; my $pkg = ref $self; for my $level (keys %{ PRI() }) { my $is_active = PRI->{$level} <= PRI->{$self->{level}}; no strict 'refs'; no warnings 'redefine'; ## no critic *{$pkg.q{::}.$level} = $is_active ? \&{$pkg.q{::_}.$level} : sub {}; } return; } sub _generate_methods { ## no critic(ProhibitExcessComplexity) my ($self) = @_; my $pkg = ref $self; my %feature = map {$_=>1} $self->{prefix} =~ /%(.)/xmsg; $feature{timestamp} = $self->{type} eq 'unix' && $self->{add_timestamp}; my @pfx = split /(%.)/xms, $self->{prefix}; for (0 .. $#pfx) { utf8::encode($pfx[$_]); } for my $level (keys %{ PRI() }) { # ... begin my $code = <<'EOCODE'; sub { my $self = shift; my $msg = @_==1 ? $_[0] : sprintf shift, map {ref eq 'CODE' ? $_->() : $_} @_; utf8::encode($msg); EOCODE # ... if needed, get current time if ($feature{S}) { $code .= <<'EOCODE'; my $msec = sprintf '%.05f', Time::HiRes::time(); my $time = int $msec; EOCODE } elsif ($feature{D} || $feature{T} || $feature{timestamp}) { $code .= <<'EOCODE'; my $time = time; EOCODE } # ... if needed, update caches if ($feature{D} || $feature{T}) { $code .= <<'EOCODE'; if ($self->{_dt_time} != $time) { $self->{_dt_time} = $time; my ($sec,$min,$hour,$mday,$mon,$year) = localtime $time; $self->{_date} = sprintf '%04d-%02d-%02d', $year+1900, $mon+1, $mday; $self->{_time} = sprintf '%02d:%02d:%02d', $hour, $min, $sec; } EOCODE } if ($feature{timestamp}) { $code .= <<'EOCODE'; if ($self->{_header_time} != $time) { $self->_update_header(); } EOCODE } # ... calculate prefix $code .= <<'EOCODE'; my $prefix = q{} EOCODE for my $pfx (@pfx) { if ($pfx eq q{%L}) { ## no critic(ProhibitCascadingIfElse) $code .= <<"EOCODE" . "\Q$level\E" EOCODE } elsif ($pfx eq q{%S}) { $code .= <<'EOCODE' . $msec EOCODE } elsif ($pfx eq q{%D}) { $code .= <<'EOCODE' . $self->{_date} EOCODE } elsif ($pfx eq q{%T}) { $code .= <<'EOCODE' . $self->{_time} EOCODE } elsif ($pfx eq q{%P}) { $code .= <<'EOCODE' . caller(0) EOCODE } elsif ($pfx eq q{%F}) { $code .= <<'EOCODE' . do { my $s = (caller(1))[3] || q{}; substr $s, 1+rindex $s, ':' } EOCODE } elsif ($pfx eq q{%_}) { $code .= <<'EOCODE' . do { my $n=0; 1 while caller(2 + $n++); ' ' x $n } EOCODE } elsif ($pfx eq q{%%}) { $code .= <<'EOCODE' . '%' EOCODE } else { $code .= <<"EOCODE" . "\Q$pfx\E" EOCODE } } $code .= <<'EOCODE'; ; EOCODE # ... output if ($self->{type} eq 'fh') { $code .= <<'EOCODE'; print { $self->{fh} } $prefix, $msg, "\n" or die "print() to log: $!"; EOCODE } elsif ($self->{type} eq 'unix') { $code .= <<"EOCODE"; my \$header = \$self->{_header_$level}; EOCODE $code .= <<'EOCODE'; send $self->{_sock}, $header.$prefix.$msg, 0 or do { $self->_connect_unix(); send $self->{_sock}, $header.$prefix.$msg, 0 or die "send() to syslog: $!"; }; EOCODE } else { croak '{type} should be "fh" or "unix"'; } # ... end $code .= <<'EOCODE'; } EOCODE # install generated method no strict 'refs'; no warnings 'redefine'; ## no critic *{$pkg.'::_'.$level} = eval $code; ## no critic } return; } 1; # Magic true value required at end of module __END__ =encoding utf8 =head1 NAME Log::Fast - Fast and flexible logger =head1 SYNOPSIS use Log::Fast; $LOG = Log::Fast->global(); $LOG = Log::Fast->new({ level => 'WARN', prefix => '%D %T [%L] ', type => 'fh', fh => \*STDOUT, }); use Sys::Syslog qw( LOG_DAEMON ); $LOG->config({ prefix => '', type => 'unix', path => '/dev/log', facility => LOG_DAEMON, add_timestamp => 1, add_hostname => 1, hostname => 'somehost', ident => 'someapp', add_pid => 1, pid => $$, }); $LOG->ident('anotherapp'); $LOG->level('INFO'); $LOG->ERR('Some error'); $LOG->WARN('Some warning'); $LOG->NOTICE('user %s logged in', $user); $LOG->INFO('data loaded'); $LOG->DEBUG('user %s have %d things', $user, sub { return SlowOperation_GetAmountOfThingsFor($user); }); =head1 DESCRIPTION This is very fast logger, designed for use in applications with thousands high-level events/operations per second (like network servers with thousands clients or web spiders which download hundreds url per second). For example, on Core2Duo sending about 5000 messages to log on enabled log levels or 20000 messages on disabled log levels in I will slow down your application only by 2-3%. Comparing to some other CPAN modules, this one (in average): faster than L in about 45 times, faster than L in about 15 times, faster than L in about 7 times, and slower than L in about 2 times. =head2 FEATURES =over =item * Global and local logger objects =item * Output to any open filehandle or local syslog =item * 5 log levels: ERR, WARN, NOTICE, INFO, DEBUG =item * Configurable prefix (log level, date/time, caller function name) =item * sprintf() support =item * Unicode support (UTF8) =item * Can avoid calculating log message content on disabled log levels =back =head1 INTERFACE =over =item Log::Fast->global() When called first time will create global log object using L (you can reconfigure it using C later). Global log object is useful if your application consists of several independent modules which should share same logging options configured outside of these modules. In this case all these modules should use same C log object instead of creating C independent log objects in each module. Return global log object. =item Log::Fast->new( [\%opt] ) Create new log object, configured using L and user-provided options, if any. Return created log object. =item $LOG->config( \%opt ) Reconfigure log object. Any options (see L) can be changed at any time, including changing output B<{type}> or setting options useless with current output type (new values for these options will be used later, if output type will be changed). If you need to change only log B<{level}> or syslog's B<{ident}> you should use C or C methods because they are much faster than more general C. Return nothing. Throw exception if unable to connect to syslog. =item $LOG->level( [$level] ) If B<$level> given will change current log level. This is same as call C<< config({ level=>$level }) >> but much faster. Return previous log level. =item $LOG->ident( [$ident] ) If B<$ident> given will change current syslog's ident. This is same as call C<< config({ ident=>$ident }) >> but much faster. Return previous syslog's ident. =item $LOG->ERR( $message ) =item $LOG->ERR( $format, @list ) =item $LOG->WARN( $message ) =item $LOG->WARN( $format, @list ) =item $LOG->NOTICE( $message ) =item $LOG->NOTICE( $format, @list ) =item $LOG->INFO( $message ) =item $LOG->INFO( $format, @list ) =item $LOG->DEBUG( $message ) =item $LOG->DEBUG( $format, @list ) Output B<$message> to log using different log levels. If B<$format, @list> used instead of B<$message>, then use C to calculate log message. If B<@list> will contain CODEREF, they will be called (in LIST context) and returned values will be placed inside B<@list> inplace of CODEREF. This can be used to avoid calculating log message (or it part) on disabled log levels - these CODEREFs will be executed only on enabled log levels. Example available in L. If B<$message> or items in B<@list> will be Unicode strings, they will be converted to UTF8 before sending to log. Return nothing. Throw exception if fail to write message to log. =back =head1 OPTIONS Defaults for all options are: level => 'DEBUG', prefix => q{}, type => 'fh', fh => \*STDERR, # these will be used if you will call config({ type=>'unix' }) path => Sys::Syslog::_PATH_LOG() || '/dev/log', facility => LOG_USER, add_timestamp => 1, add_hostname => 0, hostname => Sys::Hostname::hostname(), ident => ..., # calculated from $0 add_pid => 1, pid => $$, =over =item level Current log level. Possible values are: C<'ERR'>, C<'WARN'>, C<'NOTICE'>, C<'INFO'>, C<'DEBUG'>. Only messages on current or higher levels will be sent to log. =item prefix String, which will be output at beginning of each log message. May contain these placeholders: %L - log level of current message %S - hi-resolution time (seconds.microseconds) %D - current date in format YYYY-MM-DD %T - current time in format HH:MM:SS %P - caller's function package ('main' or 'My::Module') %F - caller's function name %_ - X spaces, where X is current stack depth %% - % character Example output with prefix C<'%D %T [%L]%_%P::%F() '>: 2010-11-17 18:06:20 [INFO] main::() something from main script 2010-11-17 18:06:53 [INFO] main::a() something from a 2010-11-17 18:09:09 [INFO] main::b2() something from b1->b2 2010-11-17 18:06:56 [INFO] main::c() something from c If it will be Unicode string, it will be converted to UTF8. =item type Output type. Possible values are: C<'fh'> (output to any already open filehandle) and C<'unix'> (output to syslog using UNIX socket). When B<{type}> set to C<'fh'> you have to also set B<{fh}> to any open filehandle (like C<\*STDERR>). When B<{type}> set to C<'unix'> you have to also set B<{path}> to path to existing unix socket (typically it's C<'/dev/log'>). Luckily, default values for both B<{fh}> and B<{path}> are already provided, so usually it's enough to just set B<{type}>. =item fh File handle to write log messages if B<{type}> set to C<'fh'>. =item path Syslog's UNIX socket path to write log messages if B<{type}> set to C<'unix'>. =item facility Syslog's facility (see L for a list of well-known facilities). This module doesn't export any constants, so if you wanna change it from default LOG_USER value, you should import facility constants from L module. Example available in L. =item add_timestamp If TRUE will include timestamp in syslog messages. =item add_hostname If TRUE will include hostname in syslog messages. =item hostname Host name which will be included in syslog messages if B<{add_hostname}> is TRUE. =item ident Syslog's ident (application name) field. If it will be Unicode string, it will be converted to UTF8. Using non-ASCII ALPHANUMERIC ident isn't allowed by RFC, but usually works. =item add_pid If TRUE will include PID in syslog messages. =item pid PID which will be included in syslog messages if B<{add_pid}> is TRUE. =back =head1 SPEED HINTS Empty prefix is fastest. Prefixes C<%L>, C<%P> and C<%%> are fast enough, C<%D> and C<%T> has average speed, C<%S>, C<%F> and C<%_> are slowest. Output to file is about 4 times faster than to syslog. Calling log with single parameter is faster than with many parameters (because in second case sprintf() have to be used). =head1 BUGS AND LIMITATIONS No bugs have been reported. =head1 SUPPORT Please report any bugs or feature requests through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 AUTHOR Alex Efros C<< >> =head1 LICENSE AND COPYRIGHT Copyright 2010,2012 Alex Efros . This program is distributed under the MIT (X11) License: L Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Log-Fast-1.0.6/README0000644000175000017500000000267611756571257014307 0ustar powermanpowermanLog-Fast INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Log::Fast LICENSE AND COPYRIGHT Copyright (C) 2010,2012 Alex Efros This program is distributed under the MIT (X11) License: http://www.opensource.org/licenses/mit-license.php Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Log-Fast-1.0.6/Makefile.PL0000644000175000017500000000075211754247071015362 0ustar powermanpowermanuse inc::Module::Install; name 'Log-Fast'; all_from 'lib/Log/Fast.pm'; requires 'version'; requires 'Sys::Syslog' => '0.29'; test_requires 'Test::More'; test_requires 'Test::Exception'; recommends 'Test::CheckManifest' => '0.9'; recommends 'Test::Perl::Critic'; recommends 'Test::Pod::Coverage' => '1.08'; recommends 'Pod::Coverage' => '0.18'; recommends 'Test::Pod' => '1.22'; auto_install; WriteAll; Log-Fast-1.0.6/inc/0000755000175000017500000000000012223275045014147 5ustar powermanpowermanLog-Fast-1.0.6/inc/Module/0000755000175000017500000000000012223275045015374 5ustar powermanpowermanLog-Fast-1.0.6/inc/Module/Install.pm0000644000175000017500000003013512223275037017343 0ustar powermanpowerman#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Log-Fast-1.0.6/inc/Module/AutoInstall.pm0000644000175000017500000006216212223275037020201 0ustar powermanpowerman#line 1 package Module::AutoInstall; use strict; use Cwd (); use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps, $UpgradeDeps ); my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps, $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps, $PostambleActionsListAllDeps, $PostambleUsed, $NoTest); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub _installdeps_target { $InstallDepsTarget = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) { $UpgradeDeps = 1; __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } elsif ( $arg =~ /^--all(?:deps)?$/ ) { $AllDeps = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); # We want to know if we're under CPAN early to avoid prompting, but # if we aren't going to try and install anything anyway then skip the # check entirely since we don't want to have to load (and configure) # an old CPAN just for a cosmetic message $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget; while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. my $cur = _version_of($mod); if (_version_cmp ($cur, $arg) >= 0) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { if (not defined $cur) # indeed missing { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; } else { # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above print "too old. ($cur < $arg)\n"; } push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or ($mandatory and $UnderCPAN) or $AllDeps or $InstallDepsTarget or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } if ( @Missing and not( $CheckOnly or $UnderCPAN) ) { require Config; my $make = $Config::Config{make}; if ($InstallDepsTarget) { print "*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n"; } else { print "*** Dependencies will be installed the next time you type '$make'.\n"; } # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; return (@Existing, @Missing); } sub _running_under { my $thing = shift; print <<"END_MESSAGE"; *** Since we're running under ${thing}, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing or @_; if ($ENV{PERL5_CPANM_IS_RUNNING}) { return _running_under('cpanminus'); } my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING}; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS'); } require CPAN; if ($CPAN::VERSION > '1.89') { if ($cpan_env) { return _running_under('CPAN'); } return; # CPAN.pm new enough, don't need to check further } # last ditch attempt, this -will- configure CPAN, very sorry _load_cpan(1); # force initialize even though it's already loaded # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } if ($UpgradeDeps) { push @modules, @installed; @installed = (); } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } push @config, 'prereqs', $value; } elsif ( $key eq 'force' ) { push @config, $key, $value; } elsif ( $key eq 'notest' ) { push @config, 'skiptest', $value; } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^(?:force|notest)$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } if ($args{notest} && (not CPAN::Shell->can('notest'))) { die "Your version of CPAN is too old to support the 'notest' pragma"; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = do { if ($args{force}) { CPAN::Shell->force( install => $pkg ) } elsif ($args{notest}) { CPAN::Shell->notest( install => $pkg ) } else { CPAN::Shell->install($pkg) } }; $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # report version without loading a module sub _version_of { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; foreach my $dir ( @INC ) { next if ref $dir; my $path = File::Spec->catfile($dir, $file); next unless -e $path; require ExtUtils::MM_Unix; return ExtUtils::MM_Unix->parse_version($path); } return undef; } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION and $CPAN::Config and not @_; require CPAN; # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to # CPAN::HandleConfig->load. CPAN reports that the redirection # is deprecated in a warning printed at the user. # CPAN-1.81 expects CPAN::HandleConfig->load, does not have # $CPAN::HandleConfig::VERSION but cannot handle # CPAN::Config->load # Which "versions expect CPAN::Config->load? if ( $CPAN::HandleConfig::VERSION || CPAN::HandleConfig->can('load') ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison # return values same as <=> sub _version_cmp { my ( $cur, $min ) = @_; return -1 unless defined $cur; # if 0 keep comparing return 1 unless $min; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return version->new($cur) <=> version->new($min); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return Sort::Versions::versioncmp( $cur, $min ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return $cur <=> $min; } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); my $deps_list = join( ',', @Missing, @Existing ); $PostambleActionsUpgradeDeps = "\$(PERL) $0 --config=$config --upgradedeps=$deps_list"; my $config_notest = join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}), 'notest', 1 ) if $Config; $PostambleActionsNoTest = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); $PostambleActionsUpgradeDepsNoTest = "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list"; $PostambleActionsListDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing); my @all = (@Missing, @Existing); $PostambleActionsListAllDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; my $fragment; $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget; config :: installdeps \t\$(NOECHO) \$(NOOP) AUTO_INSTALL $fragment .= <<"END_MAKE"; checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions installdeps_notest :: \t$PostambleActionsNoTest upgradedeps :: \t$PostambleActionsUpgradeDeps upgradedeps_notest :: \t$PostambleActionsUpgradeDepsNoTest listdeps :: \t$PostambleActionsListDeps listalldeps :: \t$PostambleActionsListAllDeps END_MAKE return $fragment; } 1; __END__ #line 1193 Log-Fast-1.0.6/inc/Module/Install/0000755000175000017500000000000012223275045017002 5ustar powermanpowermanLog-Fast-1.0.6/inc/Module/Install/Base.pm0000644000175000017500000000214712223275037020217 0ustar powermanpowerman#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Log-Fast-1.0.6/inc/Module/Install/Can.pm0000644000175000017500000000615712223275037020053 0ustar powermanpowerman#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Log-Fast-1.0.6/inc/Module/Install/Fetch.pm0000644000175000017500000000462712223275037020403 0ustar powermanpowerman#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Log-Fast-1.0.6/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612223275037021074 0ustar powermanpowerman#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Log-Fast-1.0.6/inc/Module/Install/Metadata.pm0000644000175000017500000004327712223275037021076 0ustar powermanpowerman#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Log-Fast-1.0.6/inc/Module/Install/Include.pm0000644000175000017500000000101512223275037020721 0ustar powermanpowerman#line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; Log-Fast-1.0.6/inc/Module/Install/Makefile.pm0000644000175000017500000002743712223275037021073 0ustar powermanpowerman#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Log-Fast-1.0.6/inc/Module/Install/Win32.pm0000644000175000017500000000340312223275037020243 0ustar powermanpowerman#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Log-Fast-1.0.6/inc/Module/Install/AutoInstall.pm0000644000175000017500000000416212223275037021603 0ustar powermanpowerman#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; my @features_require = Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); my %seen; my @requires = map @$_, map @$_, grep ref, $self->requires; while (my ($mod, $ver) = splice(@requires, 0, 2)) { $seen{$mod}{$ver}++; } my @build_requires = map @$_, map @$_, grep ref, $self->build_requires; while (my ($mod, $ver) = splice(@build_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires; while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @deduped; while (my ($mod, $ver) = splice(@features_require, 0, 2)) { push @deduped, $mod => $ver unless $seen{$mod}{$ver}++; } $self->requires(@deduped); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub installdeps_target { my ($self, @args) = @_; $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall::_installdeps_target(1); $self->auto_install(@args); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; Log-Fast-1.0.6/Changes0000644000175000017500000000123212223275007014665 0ustar powermanpowermanRevision history for Log-Fast 1.0.6 Thu Oct 3 17:06:57 EEST 2013 Remove MYMETA.* 1.0.5 Tue May 22 04:50:09 EEST 2012 INCOMPATIBLE! fixed: level() and ident() now return previous value instead of current. 1.0.4 Sun May 13 06:01:33 EEST 2012 Fix requirements. 1.0.3 Fri Dec 03 14:39:54 EET 2010 fixed t/raise.t on platforms without AF_UNIX fixed t/syslog.t for mday < 10 1.0.2 Thu Nov 18 21:38:24 EET 2010 use Sys::Syslog::_PATH_LOG() for default {path} fixed t/raise.t on platforms without /dev/log fixed t/syslog.t on Win 1.0.1 Thu Nov 18 07:46:54 EET 2010 require perl 5.8 added t/syslog.t 1.0.0 Wed Nov 17 22:36:01 EET 2010 Initial release.