view release on metacpan or  search on metacpan

script/_zodiac-of  view on Meta::CPAN

#
#=for Pod::Coverage ^(.+)$
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 2017 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### 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 ###
###
## name:      Mo::Golf
## abstract:  Module for Compacting Mo Modules
## author:    Ingy döt Net <ingy@ingy.net>
## license:   perl
## copyright: 2011
## see:
## - Mo
#
#use strict;
#use warnings;
#package Mo::Golf;
#
#our $VERSION='0.40';
#
#use PPI;
#
## This is the mapping of common names to shorter forms that still make some
## sense.
#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 || [] };
#    }
#
#    return $tree->serialize . "\n";
#}
#
#sub tok { "PPI::Token::$_[0]" }
#
#sub _finder_subs {
#    return (
#        comments => sub { $_[1]->isa( tok 'Comment' ) },
#
#        duplicate_whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#
#            $current->set_content(' ') if 1 < length $current->content;
#
#            return 0 if !$current->next_token;
#            return 0 if !$current->next_token->isa( tok 'Whitespace' );
#            return 1;
#        },
#
#        whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#            my $prev = $current->previous_token;
#            my $next = $current->next_token;
#
#            return 1 if $prev->isa( tok 'Number' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; # my $P
#            return 1 if $prev->isa( tok 'Word' )   and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; # my $P
#            return 1 if $prev->isa( tok 'Symbol' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; # $VERSION =  but not $v and
#
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Single' ) and $next->content =~ /^\W/; # eq ''

script/_zodiac-of  view on Meta::CPAN

#our @EXPORT = qw{ Dump Load };
#our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed };
#our (
#    $UseCode, $DumpCode, $LoadCode,
#    $SpecVersion,
#    $UseHeader, $UseVersion, $UseBlock, $UseFold, $UseAliases,
#    $Indent, $SortKeys, $Preserve,
#    $AnchorPrefix, $CompressSeries, $InlineSeries, $Purity,
#    $Stringify, $Numify
#);
#
#
#use YAML::Old::Node; # XXX This is a temp fix for Module::Build
#use Scalar::Util qw/ openhandle /;
#
## XXX This VALUE nonsense needs to go.
#use constant VALUE => "\x07YAML\x07VALUE\x07";
#
## YAML Object Properties
#has dumper_class => default => sub {'YAML::Old::Dumper'};
#has loader_class => default => sub {'YAML::Old::Loader'};
#has dumper_object => default => sub {$_[0]->init_action_object("dumper")};
#has loader_object => default => sub {$_[0]->init_action_object("loader")};
#
#sub Dump {
#    my $yaml = YAML::Old->new;
#    $yaml->dumper_class($YAML::DumperClass)
#        if $YAML::DumperClass;
#    return $yaml->dumper_object->dump(@_);
#}
#
#sub Load {
#    my $yaml = YAML::Old->new;
#    $yaml->loader_class($YAML::LoaderClass)
#        if $YAML::LoaderClass;
#    return $yaml->loader_object->load(@_);
#}
#
#{
#    no warnings 'once';
#    # freeze/thaw is the API for Storable string serialization. Some
#    # modules make use of serializing packages on if they use freeze/thaw.
#    *freeze = \ &Dump;
#    *thaw   = \ &Load;
#}
#
#sub DumpFile {
#    my $OUT;
#    my $filename = shift;
#    if (openhandle $filename) {
#        $OUT = $filename;
#    }
#    else {
#        my $mode = '>';
#        if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
#            ($mode, $filename) = ($1, $2);
#        }
#        open $OUT, $mode, $filename
#          or YAML::Old::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, "$!");
#    }
#    binmode $OUT, ':utf8';  # if $Config{useperlio} eq 'define';
#    local $/ = "\n"; # reset special to "sane"
#    print $OUT Dump(@_);
#    unless (ref $filename eq 'GLOB') {
#        close $OUT
#          or do {
#              my $errsav = $!;
#              YAML::Old::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT_CLOSE', $filename, $errsav);
#          }
#    }
#}
#
#sub LoadFile {
#    my $IN;
#    my $filename = shift;
#    if (openhandle $filename) {
#        $IN = $filename;
#    }
#    else {
#        open $IN, '<', $filename
#          or YAML::Old::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, "$!");
#    }
#    binmode $IN, ':utf8';  # if $Config{useperlio} eq 'define';
#    return Load(do { local $/; <$IN> });
#}
#
#sub init_action_object {
#    my $self = shift;
#    my $object_class = (shift) . '_class';
#    my $module_name = $self->$object_class;
#    eval "require $module_name";
#    $self->die("Error in require $module_name - $@")
#        if $@ and "$@" !~ /Can't locate/;
#    my $object = $self->$object_class->new;
#    $object->set_global_options;
#    return $object;
#}
#
#my $global = {};
#sub Bless {
#    require YAML::Old::Dumper::Base;
#    YAML::Old::Dumper::Base::bless($global, @_)
#}
#sub Blessed {
#    require YAML::Old::Dumper::Base;
#    YAML::Old::Dumper::Base::blessed($global, @_)
#}
#sub global_object { $global }
#
#1;
### YAML/Old/Dumper.pm ###
#package YAML::Old::Dumper;
#
#use YAML::Old::Mo;
#extends 'YAML::Old::Dumper::Base';
#
#use YAML::Old::Dumper::Base;
#use YAML::Old::Node;
#use YAML::Old::Types;
#use Scalar::Util qw();
#use B ();
#use Carp ();
#
## Context constants
#use constant KEY       => 3;
#use constant BLESSED   => 4;
#use constant FROMARRAY => 5;
#use constant VALUE     => "\x07YAML\x07VALUE\x07";
#
## Common YAML character sets
#my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
#my $LIT_CHAR    = '|';
#
##==============================================================================
## OO version of Dump. YAML->new->dump($foo);
#sub dump {
#    my $self = shift;
#    $self->stream('');
#    $self->document(0);
#    for my $document (@_) {
#        $self->{document}++;
#        $self->transferred({});
#        $self->id_refcnt({});