view release on metacpan or  search on metacpan

lib/Text/Glob/DWIW.pm  view on Meta::CPAN

#~~ _sort used for subtraction pattern
sub __idx ($$)  { my $p=index $_[0],$_[1]; $p<0?'+Inf':$p }
sub _sort       { sort { __idx($b,'*')<=>__idx($a,'*')||__idx($b,'?')<=>__idx($a,'?')||
                         length($b)<=>length $a } @_ }
                # ^- one real condition: the pattern should find itself at last.
#~ forester
sub _flatten (@) { map { _reft($_) ? &_flatten(_deref $_) : $_ } @_ }
sub _markflt (@) { join'',map { _reft($_) ? '('.&_markflt(_deref$_).')' : $_ } @_ }#4capture
sub _treejoin($) { join'',&_flatten } # fixed ''
sub _forestjoin  { map { join'',_flatten $_ } @_ }
sub _treemap(&@) { my$f=shift; map{ _reft($_)?_doref &_treemap($f,_deref $_):$f->($_) } @_}
sub _forestmap(&@) {my$f=shift; map [&_treemap($f,@$_)], @_ }
sub _treefor1(&@){ my $f=shift; for (@_) { my$t=_reft $_; !$t ? $f->($_) :
                   &_treefor1($f,'ARRAY'eq$t?@$_:$t=~/SCAL|REF/?$$_:$_) } }
# ^- was: ...&_treefor1($f,_deref $_).. with _deref :lvalue but this bail out under 5.10
#         with "Bizarre copy of ARRAY in sassign at line 25 or in overload::Method ...."
sub _treefirst(&@) { my $f=shift; my $t=_reft $_[0]; !$t ? do{$f->($_[0])for$_[0]} :
                     &_treefirst($f, 'ARRAY'eq$t ? $_[0][0] : ${$_[0]}) }
sub _drop_anchor ($;$$) # rm outside anchors
{ my ($v,$xaa,$xae)=@_; return unless $xaa||$xae; my($A,$a,$e,$pos)=(0,0,0,0);
  while ($pos<@$v)
  { if (_reft $v->[$pos]) { ($a,$e)=&_drop_anchor($v->[$pos],$xaa,$xae); $A||=$a }
    else { $A||=$a=$xaa&&substr($v->[$pos],0,1)eq'^'; $e=$xae&&substr($v->[$pos],-1)eq'$' }
    if ($a&&$pos>1)    { splice @$v,0,$pos-1; $pos=0 }
    if ($e&&$pos<$#$v) { splice @$v,$pos+1; last }
    ++$pos # anchors self are latter removed because ref and therfore aliased
  }