view release on metacpan or  search on metacpan

lib/App/Greple/PwBlock.pm  view on Meta::CPAN

    my $obj = bless {
	orig   => "",
	masked => "",
	id     => {},
	pw     => {},
	matrix => {},
    }, $class;

    $obj->parse(shift) if @_;

    $obj;
}

sub id {
    my $obj = shift;
    my $label = shift;
    exists $obj->{id}{$label} ? $obj->{id}{$label} : undef;
}

sub pw {
    my $obj = shift;
    my $label = shift;
    exists $obj->{pw}{$label} ? $obj->{pw}{$label} : undef;
}

sub cell {
    my $obj = shift;
    my($col, $row) = @_;
    if (length $col > 1) {
	($col, $row) = split //, $col;
    }
    return undef if not defined $obj->{matrix}{$col};
    $obj->matrix->{$col}{$row};
}

sub any {
    my $obj = shift;
    my $label = shift;
    $obj->id($label) // $obj->pw($label) // $obj->cell(uc $label);
}

sub orig   { $_[0]->{orig}   }
sub masked { $_[0]->{masked} }
sub matrix { $_[0]->{matrix} }


sub parse {
    my $obj = shift;
    $obj->{orig} = $obj->{masked} = shift;
    $obj->parse_matrix if config('parse_matrix');
    $obj->parse_pw if config('parse_pw');
    $obj->parse_id if config('parse_id');
    $obj;
}
    
sub make_pattern {
    my $opt = ref $_[0] eq 'HASH' ? shift : {};
    use English;
    local $LIST_SEPARATOR = '|';
    my @match = @_;
    my @except = qw(INPUT);
    push @except, @{$opt->{IGNORE}} if $opt->{IGNORE};
    qr{ ^\s*+ (?!@except) .*? (?:@match)\w*[:=]? [\ \t]* \K ( .* ) }mxi;
}

# Getopt::EX::Config support
our $config = Getopt::EX::Config->new(
    parse_matrix    => 1,
    parse_id        => 1,
    parse_pw        => 1,
    id_keys         => join(' ', 
        qw(ID ACCOUNT USER CODE NUMBER URL),
        qw(ユーザ アカウント コード 番号),
        ),
    id_chars        => '[\w\.\-\@]',
    id_color        => 'K/455',
    id_label_color  => 'S;C/555',
    pw_keys         => join(' ',
        qw(PASS PIN),
        qw(パス 暗証),
        ),
    pw_chars        => '\S',
    pw_color        => 'K/545',
    pw_label_color  => 'S;M/555',
    pw_blackout     => 1,
);

sub parse_id {
    shift->parse_xx(
	hash => 'id',
	pattern => make_pattern(split /\s+/, config('id_keys')),
	chars => config('id_chars'),
	start_label => '0',
	label_format => '[%s]',
	color => config('id_color'),
	label_color => config('id_label_color'),
	blackout => 0,
	);
}		   

sub parse_pw {
    shift->parse_xx(
	hash => 'pw',
	pattern => make_pattern({IGNORE => [ 'URL' ]}, split /\s+/, config('pw_keys')),
	chars => config('pw_chars'),
	start_label => 'a',
	label_format => '[%s]',
	color => config('pw_color'),
	label_color => config('pw_label_color'),
	blackout => config('pw_blackout'),
	);
}		   

sub parse_xx {
    my $obj = shift;
    my %opt = @_;
    my %hash;
    $obj->{$opt{hash}} = \%hash;

    my $label_id = $opt{start_label};
    my $chars = qr/$opt{chars}/;