X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/kivitendo-erp.git/blobdiff_plain/deb4d2dbb676d7d6f69dfe7815d6e0cb09bd4a44..53593baa211863fbf66540cf1bcc36c8fb37257f:/modules/override/YAML/Mo.pm diff --git a/modules/override/YAML/Mo.pm b/modules/override/YAML/Mo.pm deleted file mode 100644 index c669ff090..000000000 --- a/modules/override/YAML/Mo.pm +++ /dev/null @@ -1,80 +0,0 @@ -package YAML::Mo; $VERSION = '0.88'; -# use Mo qw[builder default import]; -# The following line of code was produced from the previous line by -# Mo::Inline version 0.31 -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; - -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); -}; - -# This code needs to be refactored to be simpler and more precise, and no, -# Scalar::Util doesn't DWIM. -# -# Can't handle: -# * blessed regexp -*{$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::Error; - - my $code = shift || 'unknown error'; - my $error = YAML::Error->new(code => $code); - $error->line($self->line) if $self->can('line'); - $error->document($self->document) if $self->can('document'); - $error->arguments([@_]); - return $error; -}; - -1;