view release on metacpan or  search on metacpan

script/rsybak  view on Meta::CPAN

#        my $mod = $args{name};
#        $mod = $prefix . $mod unless index($mod, $prefix) == 0;
#        (my $mod_pm = "$mod.pm") =~ s!::!/!g;
#        require $mod_pm;
#        $hooks = &{"$mod\::get_hooks"}(%{ $args{conf} || {} });
#    }
#
#    {
#        last unless $args{replace_package_regex};
#        my $all_hooks;
#        if (!$args{target}) {
#            $all_hooks = \%Log::ger::Global_Hooks;
#        } elsif ($args{target} eq 'package') {
#            $all_hooks = $Log::ger::Per_Package_Hooks{ $args{target_arg} };
#        } elsif ($args{target} eq 'object') {
#            my ($addr) = $args{target_arg} =~ $Log::ger::re_addr;
#            $all_hooks = $Log::ger::Per_Object_Hooks{$addr};
#        } elsif ($args{target} eq 'hash') {
#            my ($addr) = $args{target_arg} =~ $Log::ger::re_addr;
#            $all_hooks = $Log::ger::Per_Hash_Hooks{$addr};
#        }
#        last unless $all_hooks;
#        for my $phase (keys %$all_hooks) {
#            my $hooks = $all_hooks->{$phase};
#            for my $i (reverse 0..$#{$hooks}) {
#                splice @$hooks, $i, 1
#                    if $hooks->[$i][0] =~ $args{replace_package_regex};
#            }
#        }
#    }
#
#    for my $phase (keys %$hooks) {
#        my $hook = $hooks->{$phase};
#        if (defined $args{target}) {
#            add_per_target_hook(
#                $args{target}, $args{target_arg}, $phase, $hook);
#        } else {
#            add_hook($phase, $hook);
#        }
#    }
#
#    my $reinit = $args{reinit};
#    $reinit = 1 unless defined $reinit;
#    if ($reinit) {
#        if (defined $args{target}) {
#            reinit_target($args{target}, $args{target_arg});
#        } else {
#            reinit_all_targets();
#        }
#    }
#}
#
#1;
#
#__END__
#
### Mo.pm ###
#package Mo;
#$Mo::VERSION = '0.40';
#$VERSION='0.40';
#no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{my$c=shift;my$s=bless{@_},$c;my%n=%{$c.'::'.':E'};map{$s->{$_}=$n{$_}->()if!exists$s->{$_}}keys%n;$s};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&...
### Mo/Golf.pm ###
#
#use strict;
#use warnings;
#package Mo::Golf;
#
#our $VERSION='0.40';
#
#use PPI;
#
#my %short_names = (
#    (
#        map {($_, substr($_, 0, 1))}
#        qw(
#            args builder class default exports features
#            generator import is_lazy method MoPKG name
#            nonlazy_defaults options reftype self
#        )
#    ),
#    build_subs => 'B',
#    old_constructor => 'C',
#    caller_pkg => 'P',
#);
#
#my %short_barewords = ( EAGERINIT => q{':E'}, NONLAZY => q{':N'} );
#
#my %hands_off = map {($_,1)} qw'&import *import';
#
#sub import {
#    return unless @_ == 2 and $_[1] eq 'golf';
#    binmode STDOUT;
#    my $text = do { local $/; <> };
#    print STDOUT golf( $text );
#};
#
#sub golf {
#    my ( $text ) = @_;
#
#    my $tree = PPI::Document->new( \$text );
#
#    my %finder_subs = _finder_subs();
#
#    my @order = qw( comments duplicate_whitespace whitespace trailing_whitespace );
#
#    for my $name ( @order ) {
#        my $elements = $tree->find( $finder_subs{$name} );
#        die $@ if !defined $elements;
#        $_->delete for @{ $elements || [] };
#    }
#
#    $tree->find( $finder_subs{$_} )
#      for qw( del_superfluous_concat del_last_semicolon_in_block separate_version shorten_var_names shorten_barewords );
#    die $@ if $@;
#
#    for my $name ( 'double_semicolon' ) {
#        my $elements = $tree->find( $finder_subs{$name} );
#        die $@ if !defined $elements;
#        $_->delete for @{ $elements || [] };
#    }
#

script/rsybak  view on Meta::CPAN

#      if defined $YAML::LoadCode or defined $YAML::UseCode;
#    $self->preserve($YAML::Preserve) if defined $YAML::Preserve;
#    $self->numify($YAML::Numify) if defined $YAML::Numify;
#}
#
#sub load {
#    die 'load() not implemented in this class.';
#}
#
#1;
### YAML/Old/Marshall.pm ###
#use strict; use warnings;
#package YAML::Old::Marshall;
#
#use YAML::Old::Node ();
#
#sub import {
#    my $class = shift;
#    no strict 'refs';
#    my $package = caller;
#    unless (grep { $_ eq $class} @{$package . '::ISA'}) {
#        push @{$package . '::ISA'}, $class;
#    }
#
#    my $tag = shift;
#    if ( $tag ) {
#        no warnings 'once';
#        $YAML::TagClass->{$tag} = $package;
#        ${$package . "::YamlTag"} = $tag;
#    }
#}
#
#sub yaml_dump {
#    my $self = shift;
#    no strict 'refs';
#    my $tag = ${ref($self) . "::YamlTag"} || 'perl/' . ref($self);
#    $self->yaml_node($self, $tag);
#}
#
#sub yaml_load {
#    my ($class, $node) = @_;
#    if (my $ynode = $class->yaml_ynode($node)) {
#        $node = $ynode->{NODE};
#    }
#    bless $node, $class;
#}
#
#sub yaml_node {
#    shift;
#    YAML::Old::Node->new(@_);
#}
#
#sub yaml_ynode {
#    shift;
#    YAML::Old::Node::ynode(@_);
#}
#
#1;
### YAML/Old/Mo.pm ###
#package YAML::Old::Mo;
#no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{my$c=shift;my$s=bless{@_},$c;my%n=%{$c.'::'.':E'};map{$s->{$_}=$n{$_}->()if!exists$s->{$_}}keys%n;$s};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&...
#
#our $DumperModule = 'Data::Dumper';
#
#my ($_new_error, $_info, $_scalar_info);
#
#no strict 'refs';
#*{$M.'Object::die'} = sub {
#    my $self = shift;
#    my $error = $self->$_new_error(@_);
#    $error->type('Error');
#    Carp::croak($error->format_message);
#};
#
#*{$M.'Object::warn'} = sub {
#    my $self = shift;
#    return unless $^W;
#    my $error = $self->$_new_error(@_);
#    $error->type('Warning');
#    Carp::cluck($error->format_message);
#};
#
#*{$M.'Object::node_info'} = sub {
#    my $self = shift;
#    my $stringify = $_[1] || 0;
#    my ($class, $type, $id) =
#        ref($_[0])
#        ? $stringify
#          ? &$_info("$_[0]")
#          : do {
#              require overload;
#              my @info = &$_info(overload::StrVal($_[0]));
#              if (ref($_[0]) eq 'Regexp') {
#                  @info[0, 1] = (undef, 'REGEXP');
#              }
#              @info;
#          }
#        : &$_scalar_info($_[0]);
#    ($class, $type, $id) = &$_scalar_info("$_[0]")
#        unless $id;
#    return wantarray ? ($class, $type, $id) : $id;
#};
#
#$_info = sub {
#    return (($_[0]) =~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o);
#};
#
#$_scalar_info = sub {
#    my $id = 'undef';
#    if (defined $_[0]) {
#        \$_[0] =~ /\((\w+)\)$/o or CORE::die();
#        $id = "$1-S";
#    }
#    return (undef, undef, $id);
#};
#
#$_new_error = sub {
#    require Carp;
#    my $self = shift;
#    require YAML::Old::Error;
#