package SprintfBugChecker;
use B 'OPf_STACKED';
use B::Utils qw( walkallops_filtered opgrep carp );
CHECK { check() }

sub check {
    walkallops_filtered(
        \&is_non_literal_sprintf_format,
        \&report_non_literal_sprintf_format
    );
    return;
}

sub is_non_literal_sprintf_format {

    no warnings;
    my $op   = shift;
    my $name = eval { $op->oldname };

    if ( $name eq 'sprintf' ) {
        return opgrep( { first => { sibling => { name => [qw[! const]] } } },
            $op );
    }
    elsif ( $name eq 'prtf' ) {
        if ( $op->flags & OPf_STACKED ) {
            return opgrep(
                {   first => {
                        sibling => { sibling => { name => [qw[! const]] } }
                    }
                },
                $op
            );
        }
        else {
            return opgrep(
                { first => { sibling => { name => [qw[! const]] } } }, $op );
        }
    }

    return;
}

sub report_non_literal_sprintf_format {
    warn(
        "Danger! Danger Will Robinson! at $B::Utils::file line $B::Utils::line.\n"
    );
    return;
}

"Ye olde true value."