App-Genpass-WordList

 view release on metacpan or  search on metacpan

script/_genpass-wordlist  view on Meta::CPAN

#    }
#    $hash;
#}
#
#sub merge {
#    my ($self, $l, $r) = @_;
#    $self->path([]);
#    $self->errors([]);
#    $self->mem({});
#    $self->cur_mem_key(undef);
#    my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
#    {
#        success => !@{ $self->errors },
#        error   => (@{ $self->errors } ?
#                    join(", ",
#                         map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
#                             @{ $self->errors }) : ''),
#        result  => $res,
#        backup  => $backup,
#    };
#}
#
#sub _process_todo {
#    my ($self) = @_;
#    if ($self->cur_mem_key) {
#        for my $mk (keys %{ $self->mem }) {
#            my $res = $self->mem->{$mk}{res};
#            if (defined($res) && @{ $self->mem->{$mk}{todo} }) {
#                for (@{  $self->mem->{$mk}{todo} }) {

script/_genpass-wordlist  view on Meta::CPAN

#        if (exists $self->mem->{$memkey}) {
#            $self->_process_todo;
#            if (defined $self->mem->{$memkey}{res}) {
#                return @{ $self->mem->{$memkey}{res} };
#            } else {
#                return ($key, undef, undef, 1);
#            }
#        } else {
#            $self->mem->{$memkey} = {res=>undef, todo=>[]};
#            $self->cur_mem_key($memkey);
#            my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
#            $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
#            $self->_process_todo;
#            return ($newkey, $res, $backup);
#        }
#    } else {
#        $self->_process_todo;
#        return $mh->$meth($key, $l, $r);
#    }
#}
#
#sub _path_is_included {
#    my ($self, $p1, $p2) = @_;
#    my $res = 1;

script/_genpass-wordlist  view on Meta::CPAN

#}
#
#sub merge_ARRAY_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#    return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
#    return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
#    my @res;
#    my @backup;
#    my $la = @$l;
#    my $lb = @$r;
#    push @{ $mm->path }, -1;
#    for my $i (0..($la > $lb ? $la : $lb)-1) {
#        $mm->path->[-1] = $i;
#        if ($i < $la && $i < $lb) {
#            push @backup, $l->[$i];
#            my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
#            last if @{ $mm->errors };
#            if ($is_circular) {
#                push @res, undef;
#                push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
#                    my ($subnewkey, $subres, $subbackup) = @_;
#                    $res[$i] = $subres;
#                }
#            } else {
#                push @res, $subres;
#            }
#        } elsif ($i < $la) {
#            push @res, $l->[$i];
#        } else {
#            push @res, $r->[$i];
#        }
#    }
#    pop @{ $mm->path };
#    ($key, \@res, \@backup);
#}
#
#sub _prefilter_hash {
#    my ($self, $h, $desc, $sub) = @_;
#    my $mm = $self->merger;
#
#    if (ref($sub) ne 'CODE') {
#        $mm->push_error("$desc failed: filter must be a coderef");
#        return;
#    }

script/_genpass-wordlist  view on Meta::CPAN

#    $hr;
#}
#
#sub _merge_gen {
#    my ($self, $hl, $hr, $mode, $em, $im, $emr, $imr) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#
#
#    my $res = {};
#    my $backup = {};
#
#    my %k = map {$_=>1} keys(%$hl), keys(%$hr);
#    push @{ $mm->path }, "";
#  K:
#    for my $k (keys %k) {
#        my @o;
#        $mm->path->[-1] = $k;
#        my $do_merge = 1;
#        $do_merge = 0 if $do_merge && $em  &&  $mm->_in($k, $em);
#        $do_merge = 0 if $do_merge && $im  && !$mm->_in($k, $im);
#        $do_merge = 0 if $do_merge && $emr && $k =~ /$emr/;
#        $do_merge = 0 if $do_merge && $imr && $k !~ /$imr/;
#
#        if (!$do_merge) {
#            $res->{$k} = $hl->{$k} if $hl->{$k};
#            next K;
#        }
#
#        $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
#        if ($hl->{$k}) {
#            push @o, $hl->{$k};
#        }
#        if ($hr->{$k}) {
#            my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
#            push @o, map { [$_, $hr->{$k}{$_}] } sort { $m{$b} <=> $m{$a} } keys %m;
#        }
#        my $final_mode;
#        my $is_circular;
#        my $v;
#        for my $i (0..$#o) {
#            if ($i == 0) {
#                my $mh = $mm->modes->{$o[$i][0]};
#                if (@o == 1 &&
#                        (($hl->{$k} && $mh->can("merge_left_only")) ||
#                         ($hr->{$k} && $mh->can("merge_right_only")))) {
#                    my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
#                    my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]); 
#                    next K unless defined($subnewkey);
#                    $final_mode = $newmode;
#                    $v = $res;
#                } else {
#                    $final_mode = $o[$i][0];
#                    $v = $o[$i][1];
#                }
#            } else {
#                my $m = $mm->combine_rules->{"$final_mode+$o[$i][0]"}
#                    or do {
#                        $mm->push_error("Can't merge $final_mode + $o[$i][0]");
#                        return;
#                    };
#                my ($subnewkey, $subbackup);
#                ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
#                return if @{ $mm->errors };
#                if ($is_circular) {
#                    if ($i < $#o) {
#                        $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
#                        return;
#                    }
#                    push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
#                        my ($subnewkey, $subres, $subbackup) = @_;
#                        my $final_mode = $m->[1];
#                        $res->{$k} = [$m->[1], $subres];
#                        if ($c->readd_prefix) {
#                            $self->_readd_prefix($res, $k, $c->default_mode);
#                        } else {
#                            $res->{$k} = $res->{$k}[1];
#                        }
#                    };
#                    delete $res->{$k};
#                }
#                next K unless defined $subnewkey;
#                $final_mode = $m->[1];
#            }
#        }
#        $res->{$k} = [$final_mode, $v] unless $is_circular;
#    }
#    pop @{ $mm->path };
#    ($res, $backup);
#}
#
#sub _readd_prefix {
#    my ($self, $hh, $k, $defmode) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#
#    my $m = $hh->{$k}[0];
#    if ($m eq $defmode) {
#        $hh->{$k} = $hh->{$k}[1];

script/_genpass-wordlist  view on Meta::CPAN

#    {
#        last unless defined $ok;
#
#        my $okl = $self->_gen_left ($l, $mode, sub {$_[0] eq $ok});
#        return if @{ $mm->errors };
#
#        my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
#        return if @{ $mm->errors };
#
#        push @{ $mm->path }, $ok;
#        my ($res, $backup);
#        {
#            local $c->{readd_prefix} = 0;
#            ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
#        }
#        pop @{ $mm->path };
#        return if @{ $mm->errors };
#
#
#        $res = $res->{$ok} ? $res->{$ok}[1] : undef;
#        if (defined($res) && ref($res) ne 'HASH') {
#            $mm->push_error("Invalid options key after merge: value must be hash");
#            return;
#        }

script/_genpass-wordlist  view on Meta::CPAN

#        }
#    }
#    if (defined($imr)) {
#        eval { $imr = qr/$imr/ };
#        if ($@) {
#            $mm->push_error("Invalid config value `include_merge_regex`: invalid regex: $@");
#            return;
#        }
#    }
#
#    my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
#    return if @{ $mm->errors };
#
#
#    if ($c->readd_prefix) {
#        for my $k (keys %$res) {
#            $self->_readd_prefix($res, $k, $c->default_mode);
#        }
#    } else {
#        $res->{$_} = $res->{$_}[1] for keys %$res;
#    }

script/_genpass-wordlist  view on Meta::CPAN

#            $mh->check_prefix_sub($s->{check_prefix_sub});
#            $mh->add_prefix_sub($s->{add_prefix_sub});
#            $mh->remove_prefix_sub($s->{remove_prefix_sub});
#        }
#    }
#
#    if ($config_replaced) {
#        $mm->config($orig_c);
#    }
#
#    ($key, $res, $backup);
#}
#
#1;
#
#__END__
#
### Data/ModeMerge/Mode/CONCAT.pm ###
#package Data::ModeMerge::Mode::CONCAT;
#
#our $DATE = '2016-07-22';