File Coverage

blib/lib/Telegram/BotKit/Keyboards.pm

Criterion	Covered	Total	%
statement	36	64	56.2
branch	6	18	33.3
condition	3	6	50.0
subroutine	6	8	75.0
pod	4	4	100.0
total	55	100	55.0

package Telegram::BotKit::Keyboards;
$Telegram::BotKit::Keyboards::VERSION = '0.03';
# ABSTRACT: Easy creation of keyboards for Telegram bots


use common::sense;
use JSON::MaybeXS;
use Encode qw(decode);

use Exporter qw(import);
our @EXPORT_OK = qw(create_one_time_keyboard create_inline_keyboard parse_reply_markup available_keys);

my $is_inline_flag = 0;   # 1 = inline / 0 = one item at column




sub create_one_time_keyboard {
	my ($keys, $k_per_row) = @_;
	if (!(defined $k_per_row)) {
		if ($is_inline_flag) { $k_per_row = scalar @$keys } else { $k_per_row = 1 };
	}

	my @keyboard;
	my @row;
	for my $i (1 .. scalar @$keys) {
		my $el = $keys->[$i-1];
		push @row, $el;
		if ((($i % $k_per_row) == 0) || ($i == scalar @$keys)) {
			push (@keyboard, [ @row ]);
			@row=();
		}
	}

	my %rpl_markup = (
		keyboard => \@keyboard,
		one_time_keyboard => JSON::MaybeXS::JSON->true
		);
	my $json = JSON::MaybeXS->new(utf8 => 1);
	return decode('UTF-8', $json->encode(\%rpl_markup));
}


sub create_inline_keyboard {
	my ($keys, $k_per_row) = @_;
	if (!(defined $k_per_row)) {
		if ($is_inline_flag) { $k_per_row = scalar @$keys } else { $k_per_row = 1 };
	}
	my @keyboard;
	my @row;
	for my $i (1 .. scalar @$keys) {
		my $el = $keys->[$i-1];
		push @row, { "text" => $el, "callback_data" => $el };
		if ((($i % $k_per_row) == 0) || ($i == scalar @$keys)) {
			push (@keyboard, [ @row ]);
			@row=();
		}
	}
	my %rpl_markup = (
		inline_keyboard  => \@keyboard
	);
	my $json = JSON::MaybeXS->new(utf8 => 1);
	return decode('UTF-8', $json->encode(\%rpl_markup));
}



sub available_keys {
	my $arr = shift;
	my $text = '[ ';
	$text.= join(' | ',@$arr);
	$text.= ' ]';
	return $text;
}


sub parse_reply_markup {
	my $reply_markup = shift;
	my $data_structure = decode_json($reply_markup);
	my @res;
	my @keyboard;
	my $is_inline_flag = 0;

	if (defined $data_structure->{inline_keyboard}) {
		@keyboard = {$data_structure->{inline_keyboard}};
		$is_inline_flag = 1;
	} elsif (defined $data_structure->{keyboard}) {
		@keyboard = @{$data_structure->{keyboard}};
	} else {
		warn "reply_markup structure isn't recognized";
		return undef;
	}

	for my $i (@keyboard) {
		for (@$i) {
			if ($is_inline_flag) {
				push @res, $_->{text};
			} else {
				push @res, $_;
			}
		}
	}

	return \@res;
}



1;

__END__