modules/override/YAML/Mo.pm

   1 package YAML::Mo; $VERSION = '0.88';
   2 # use Mo qw[builder default import];
   3 #   The following line of code was produced from the previous line by
   4 #   Mo::Inline version 0.31
   5 no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{bless{@_[1..$#_]},$_[0]};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;$a{default}or return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$a{default}->(@_):$m->(@_)}}};my$i=\&import;*{$M.import}=sub{(@_==2 and not $_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};@f=qw[builder default import];use strict;use warnings;
   6
   7 our $DumperModule = 'Data::Dumper';
   8
   9 my ($_new_error, $_info, $_scalar_info);
  10
  11 no strict 'refs';
  12 *{$M.'Object::die'} = sub {
  13     my $self = shift;
  14     my $error = $self->$_new_error(@_);
  15     $error->type('Error');
  16     Carp::croak($error->format_message);
  17 };
  18
  19 *{$M.'Object::warn'} = sub {
  20     my $self = shift;
  21     return unless $^W;
  22     my $error = $self->$_new_error(@_);
  23     $error->type('Warning');
  24     Carp::cluck($error->format_message);
  25 };
  26
  27 # This code needs to be refactored to be simpler and more precise, and no,
  28 # Scalar::Util doesn't DWIM.
  29 #
  30 # Can't handle:
  31 # * blessed regexp
  32 *{$M.'Object::node_info'} = sub {
  33     my $self = shift;
  34     my $stringify = $_[1] || 0;
  35     my ($class, $type, $id) =
  36         ref($_[0])
  37         ? $stringify
  38           ? &$_info("$_[0]")
  39           : do {
  40               require overload;
  41               my @info = &$_info(overload::StrVal($_[0]));
  42               if (ref($_[0]) eq 'Regexp') {
  43                   @info[0, 1] = (undef, 'REGEXP');
  44               }
  45               @info;
  46           }
  47         : &$_scalar_info($_[0]);
  48     ($class, $type, $id) = &$_scalar_info("$_[0]")
  49         unless $id;
  50     return wantarray ? ($class, $type, $id) : $id;
  51 };
  52
  53 #-------------------------------------------------------------------------------
  54 $_info = sub {
  55     return (($_[0]) =~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o);
  56 };
  57
  58 $_scalar_info = sub {
  59     my $id = 'undef';
  60     if (defined $_[0]) {
  61         \$_[0] =~ /\((\w+)\)$/o or CORE::die();
  62         $id = "$1-S";
  63     }
  64     return (undef, undef, $id);
  65 };
  66
  67 $_new_error = sub {
  68     require Carp;
  69     my $self = shift;
  70     require YAML::Error;
  71
  72     my $code = shift || 'unknown error';
  73     my $error = YAML::Error->new(code => $code);
  74     $error->line($self->line) if $self->can('line');
  75     $error->document($self->document) if $self->can('document');
  76     $error->arguments([@_]);
  77     return $error;
  78 };
  79
  80 1;