view release on metacpan or  search on metacpan

t/45_required_args.t  view on Meta::CPAN

        ['import_contacts phone',
            sub { $td->import_contacts([{ phone => 79991234567,
                                          first_name => 'A' }], sub {}) }],
    );
    for my $case (@string_cases) {
        my ($label, $code) = @$case;
        @sent = ();
        # asserted, not skipped: a case that croaks or sends nothing used to
        # vanish silently, so one of them tested nothing for several rounds
        ok eval { $code->(); 1 }, "$label runs" or diag $@;
        ok scalar(@sent), "$label sent a request";
        next unless @sent;
        my $req = Cpanel::JSON::XS->new->utf8->decode($sent[-1]);
        delete $req->{'@extra'};
        my $r = EV::Telegram::TDLib->execute($req);
        unlike $r->{message} // '', qr/Failed to parse/,
            "$label built from a number still parses";
    }
}

# --- a text field must carry a JSON String even when the caller's scalar has
# been used as a number. Cpanel::JSON::XS emits a Number as soon as the SV
# has IOK, and a bare numeric comparison sets it -- so the same variable
# could send once and be rejected the second time.
{
    my @text_cases = (
        ['send_message', sub { $td->send_message(-100, 42, sub {}) }],
        ['edit_message', sub { $td->edit_message(-100, 5, 42, sub {}) }],
        ['send_poll',    sub { $td->send_poll(-100, 42, [1, 2], sub {}) }],
        ['ask prompt',   sub { $td->ask(-100, 7, 42, sub {}) }],
    );
    for my $case (@text_cases) {
        my ($label, $code) = @$case;
        @sent = ();
        ok eval { $code->(); 1 }, "$label runs" or diag $@;
        ok scalar(@sent), "$label sent a request";
        next unless @sent;
        my $req = Cpanel::JSON::XS->new->utf8->decode($sent[-1]);
        delete $req->{'@extra'};
        my $r = EV::Telegram::TDLib->execute($req);
        unlike $r->{message} // '', qr/Failed to parse|Expected String/,
            "$label accepts a numeric value in its text";
    }

    # the action-at-a-distance case: a string that only later gets compared.
    # Key order is randomised per hash, so compare the encoded value, not the
    # whole document.
    my $text = "42";
    @sent = ();
    $td->send_message(-100, $text, sub {});
    like $sent[-1], qr/"text":"42"/, 'a numeric-looking string sends as a String';

    if ($text > 10) { }             # nothing but a comparison
    @sent = ();
    $td->send_message(-100, $text, sub {});
    like $sent[-1], qr/"text":"42"/,
        'and still does after the caller compares it numerically';
    unlike $sent[-1], qr/"text":42\b/, 'never as a bare JSON Number';
}

# --- the login credentials are string slots too. A phone number written
# without quotes is the obvious way to hit this.
{
    my $wait_phone = q({"@type":"updateAuthorizationState",)
                   . q("authorization_state":{"@type":"authorizationStateWaitPhoneNumber"}});
    @sent = ();
    my $c = EV::Telegram::TDLib->new(
        api_id => 1, api_hash => 'x', phone_number => 79991234567,
        database_directory => 't/tmp-authstr', on_error => sub {});
    $c->inject_raw($wait_phone);
    my ($req) = grep { /setAuthenticationPhoneNumber/ } @sent;
    ok $req, 'the phone number was sent';
    like $req, qr/"phone_number":"79991234567"/,
        'an unquoted phone number still crosses as a JSON String';
}

# --- a dying bool or "" overload must not escape guarded either. The C
# drain was fixed for this; the Perl guard is its sibling, and an escape
# there also clears $@ so nothing reports it.
{
    for my $kind (qw(stringify boolify)) {
        my $pkg = "GuardNasty\u$kind";
        my $body = $kind eq 'stringify'
            ? q{use overload '""' => sub { die "boom\n" }, fallback => 0;}
            : q{use overload 'bool' => sub { die "boom\n" },
                             '""'   => sub { 'nasty' }, fallback => 0;};
        eval "package $pkg; $body sub new { bless {}, shift } 1" or die $@;

        my @errs;
        my $c = EV::Telegram::TDLib->new(
            api_id => 1, api_hash => 'x', database_directory => 't/tmp-guard',
            on_error => sub { push @errs, $_[0] });
        my $escaped = 0;
        eval { $c->guarded(sub { die $pkg->new }); 1 } or $escaped = 1;
        ok !$escaped, "a dying $kind overload does not escape guarded";
        is scalar(@errs), 1, "and is still reported once";
    }
}

# --- the reporting path itself must not be able to escape. An on_error that
# dies is the last place left to throw from, and guarded runs during update
# dispatch, where an escape unwinds out of the handler.
{
    my $c = EV::Telegram::TDLib->new(
        api_id => 1, api_hash => 'x', database_directory => 't/tmp-onerrdie',
        on_error => sub { die "on_error itself died\n" });
    my $escaped = '';
    eval { $c->guarded(sub { die "inner\n" }); 1 } or $escaped = $@;
    is $escaped, '', 'a dying on_error does not escape guarded either';
}

# --- with no on_error at all the report has to go somewhere: it warns, which
# is the only channel left, and losing it would make a dying callback silent
{
    my $c = EV::Telegram::TDLib->new(
        api_id => 1, api_hash => 'x', database_directory => 't/tmp-nowarn');
    my @warns;
    my $escaped = '';
    {
        local $SIG{__WARN__} = sub { push @warns, $_[0] };
        eval { $c->guarded(sub { die "unheard\n" }); 1 } or $escaped = $@;