view release on metacpan or  search on metacpan

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

    exit;
}

sub command_loop {
    my $pw = shift;

    open TTY, "/dev/tty" or die;

    require Term::ReadLine;
    my $term = Term::ReadLine->new(__PACKAGE__, *TTY, *STDOUT);

    binmode TTY, ":encoding(utf8)";
    binmode STDOUT, ":encoding(utf8)";

    while ($_ = $term->readline("> ")) {
	if (config('timeout')) {
	    $SIG{ALRM} = \&pw_timeout;
	    alarm config('timeout');
	    warn "Set timeout to ", config('timeout'), " seconds\n" if config('debug');
	}
	/\S/ or next;
	$term->addhistory($_);
	s/\s+\z//;
	$_ = kana2alpha($_);

	if (my $id = $pw->id($_)) {
	    if (copy($id)) {
		printf "ID [%s] was copied to clipboard.\n", $id;
	    }
	    next;
	}
	elsif (my $pass = $pw->pw($_)) {
	    if (copy($pass)) {
		printf "Password [%s] was copied to clipboard.\n", $_;
	    }
	    next;
	}

	if (0) {}
	elsif (/^dump\b/)  { print Dumper $pw }
	elsif (/^N/i) { last }
	elsif (/^P/i) { print $pw->masked }
	elsif (/^Q/i) { return 0 }
	elsif (/^V/i) {
	    s/^.\s*//;
	    my @option = split /\s+/;
	    if (@option == 0) {
		print $pw->orig;
	    } else {
		my @values = map { $pw->any($_) // '[N/A]' } @option;
		print "@values\n";
	    }
	}
	elsif (/^show\b/i) {
	    print $pw->masked;
	}
	elsif (/^orig\b/i) {
	    print $pw->orig;
	}
	##
	## INPUT to browser
	##
	elsif (s/^input\s*//i) {
	    my %field = do {
		map {
		    m{
			( (?: name: | id: )? \w+ )
			(?|
			  \s+ (.*) # '=' がなければ残り全部
			  |
			  = ( \/.+\/ | \w+ (?:,\w+)* )
			)
		    }xg
		}
		$pw->orig =~ /^INPUT\s+(.+)/mg;
	    };
	    warn Dumper \%field if config('debug');
	    my @arg = do {
		map { /^([a-z]\d\s*){2,}$/i ? /([a-z]\d)/gi : $_ }
		map { m{^/(.+)/$} ? get_pattern($1) : $_ }
		map { $field{$_} or $_ }
		map { split /[\s=]+/ }
		map { $field{$_} or $_ }
		split /\s+/;
	    };
	    warn "@arg\n" if config('debug');
	    while (@arg >= 2) {
		my $label = shift @arg;
		my @fields = split /[,]/, $label;
		for my $field (@fields) {
		    my $item = shift @arg;
		    my $value = $pw->any($item) // $item;
		    set_browser_field($field, $value);
		}
	    }
	}
	elsif (/^set$/) {
	    for my $var (sort keys %{$config}) {
		print "$var: ";
		print config($var);
		print "\n";
	    }
	}
	elsif (s/^set\s+//) {
	    my($var, $val) = split /\s+/, $_, 2;
	    if (exists $config->{$var}) {
		$config->set($var, $val);
	    } else {
		warn "Unknown variable: $var";
	    }
	}
	elsif (/^([A-J]\d\s*)+$/i) {
	    my @chars;
	    while (/([A-J])(\d)/gi) {
		push @chars, $pw->cell(uc($1), $2) // 'ERROR';
	    }
	    print "@chars\n";
	}
	else {
	    print "Command error.\n";
	}
    }
    close TTY;

    return 1;
}

my %kana2alpha = (
    ア => 'A', イ => 'B', ウ => 'C', エ => 'D', オ => 'E',
    カ => 'F', キ => 'G', ク => 'H', ケ => 'I', コ => 'J',
    );

sub kana2alpha {
    local $_ = shift;
    s/([アイウエオカキクケコ])/$kana2alpha{$1}/g;