view release on metacpan or search on metacpan
lib/CPAN/Testers/ParseReport.pm view on Meta::CPAN
described in the C<ctgetreports> manpage. $extract is a hashref
containing the found variables.
Note: this parsing is a bit dirty but as it seems good enough I'm not
inclined to change it. We parse HTML with regexps only, not an HTML
parser. Only the entities are decoded.
In %Opt you can use
article => $some_full_article_as_scalar
view release on metacpan or search on metacpan
lib/Labyrinth/Plugin/CPAN/Builder.pm view on Meta::CPAN
$progress->( ".. processing rmauth $author $name (cleaning JSON file)" ) if(defined $progress);
my $data = read_file($destfile);
$progress->( ".. processing rmauth $author $name (read JSON file)" ) if(defined $progress);
my $store;
eval { $store = decode_json($data) };
$progress->( ".. processing rmauth $author $name (decoded JSON data)" ) if(defined $progress);
if(!$@ && $store) {
for my $row (@$store) {
next if($requests{$row->{id}}); # filter out requests
push @reports, $row;
lib/Labyrinth/Plugin/CPAN/Builder.pm view on Meta::CPAN
# clean the summary, if we have one
my @summary = $dbi->GetQuery('hash','GetAuthorSummary',$author);
if(@summary) {
$progress->( ".. processing rmauth $author $name (cleaning summary) " . scalar(@summary) . ' ' . ($summary[0] && $summary[0]->{dataset} ? 'true' : 'false') ) if(defined $progress);
my $dataset = decode_json($summary[0]->{dataset});
$progress->( ".. processing rmauth $author $name (decoded JSON summary)" ) if(defined $progress);
for my $data ( @{ $dataset->{distributions} } ) {
my $dist = $data->{dist};
my $summ = $data->{summary};
view release on metacpan or search on metacpan
t/lib/Testing.pm view on Meta::CPAN
sub _analyze_json_file {
my ($tdir, $hr) = @_;
my $lfile = File::Spec->catfile($tdir, "$hr->{json_title}.log.json");
Test::More::ok(-f $lfile, "Log file $lfile created");
my $f = Path::Tiny::path($lfile);
my $decoded = decode_json($f->slurp_utf8);
_test_json_output($decoded, $hr->{expected});
return 1;
}
sub _test_json_output {
my ($got, $expected) = @_;
view release on metacpan or search on metacpan
inc/bundle/JSON/PP.pm view on Meta::CPAN
$json->boolean_values([$false, $true])
($false, $true) = $json->get_boolean_values
By default, JSON booleans will be decoded as overloaded
C<$JSON::PP::false> and C<$JSON::PP::true> objects.
With this method you can specify your own boolean values for decoding -
on decode, JSON C<false> will be decoded as a copy of C<$false>, and JSON
C<true> will be decoded as C<$true> ("copy" here is the same thing as
assigning a value to another variable, i.e. C<$copy = $false>).
This is useful when you want to pass a decoded data structure directly
to other serialisers like YAML, Data::MessagePack and so on.
Note that this works only when you C<decode>. You can set incompatible
boolean objects (like L<boolean>), but when you C<encode> a data structure
with such boolean objects, you still need to enable C<convert_blessed>
inc/bundle/JSON/PP.pm view on Meta::CPAN
codeset range. Neither of these flags conflict with each other, although
some combinations make less sense than others.
Care has been taken to make all flags symmetrical with respect to
C<encode> and C<decode>, that is, texts encoded with any combination of
these flag values will be correctly decoded when the same flags are used
- in general, if you use different flag settings while encoding vs. when
decoding you likely have a bug somewhere.
Below comes a verbose discussion of these flags. Note that a "codeset" is
simply an abstract set of character-codepoint pairs, while an encoding
inc/bundle/JSON/PP.pm view on Meta::CPAN
=item C<utf8> flag disabled
When C<utf8> is disabled (the default), then C<encode>/C<decode> generate
and expect Unicode strings, that is, characters with high ordinal Unicode
values (> 255) will be encoded as such characters, and likewise such
characters are decoded as-is, no changes to them will be done, except
"(re-)interpreting" them as Unicode codepoints or Unicode characters,
respectively (to Perl, these are the same thing in strings unless you do
funny/weird/dumb stuff).
This is useful when you want to do the encoding yourself (e.g. when you
view release on metacpan or search on metacpan
elsif ($data{$k} eq '-') {
$data{$k} = 'NA';
}
elsif ($data{$k} =~ /\%/) {
# URI CPEs may have percent-encoded special characters
# which must be decoded to proper values.
my %decoded = (
'21' => '!', '22' => '"', '23' => '#', '24' => '$',
'25' => '%', '26' => '&', '27' => q('), '28' => '(',
'29' => ')', '2a' => '*', '2b' => '+', '2c' => ',',
'2f' => '/', '3a' => ':', '3b' => ';', '3c' => '<',
'3d' => '=', '3e' => '>', '3f' => '?', '40' => '@',
'60' => '`', '7b' => '{', '7c' => '|', '7d' => '}',
'7e' => '~',
);
$data{$k} =~ s{\%01}{?}g if index($data{$k}, '%01') >= 0;
$data{$k} =~ s{\%02}{*}g if index($data{$k}, '%02') >= 0;
foreach my $special (keys %decoded) {
if (index($data{$k}, '%' . $special) >= 0) {
$data{$k} =~ s{\%$special}{\\$decoded{$special}}ig;
}
}
}
}
# this is a compatibility layer between CPE 2.2 and 2.3.
view release on metacpan or search on metacpan
print "Connecting... " if $verbose;
my $response = $browser->get($self->{url}.'&devid='.$sn);
if($response->is_success)
{
print "OK\n" if $verbose;
my $answer=$response->decoded_content;
if($answer eq 'OK:GEN')
{
print "No defined model, using Generics.\n" if $verbose;
if(my $host=$self->getgeneric)
{
$printers++;
print "Printer found: $sn\n" if $verbose;
my $response = $browser->get($self->{url}.'&devid='.$sn);
if($response->is_success)
{
my $answer=$response->decoded_content;
if($answer eq 'OK:GEN')
{
print "No model identified, using Generics.\n" if $verbose;
if(my $host=$self->getgeneric)
{
view release on metacpan or search on metacpan
src/catch.hpp view on Meta::CPAN
break;
}
// UTF-8 territory
// Check if the encoding is valid and if it is not, hex escape bytes.
// Important: We do not check the exact decoded values for validity, only the encoding format
// First check that this bytes is a valid lead byte:
// This means that it is not encoded as 1111 1XXX
// Or as 10XX XXXX
if (c < 0xC0 ||
c >= 0xF8) {
view release on metacpan or search on metacpan
lib/CPU/Z80/Disassembler.pm view on Meta::CPAN
session, and the outout is the <bin_file>.asm. After each run, the user studies the output
.asm file, and includes new commands in the control file to add information to the
.asm file on the next run.
This function creates a template control file that contains just the hex dump of the
binary file and the decoded assembly instruction at each address, e.g.
0000 :F <bin_file>
0000 D3FD out ($FD),a
0002 01FF7F ld bc,$7FFF
0005 C3CB03 jp $03CB
view release on metacpan or search on metacpan
lib/CSAF/Util/CVSS.pm view on Meta::CPAN
sub decode_cvss_vector_string {
my $vector_string = shift;
my $decoded = {};
if ($vector_string =~ /^CVSS:3[.][0-1]\/(.*)/) {
my %cvss = split /[:\/]/, $1;
lib/CSAF/Util/CVSS.pm view on Meta::CPAN
if (defined $CVSS3_METRIC_LABEL->{$metric}) {
my $value = $cvss{$metric};
my $label = $CVSS3_METRIC_LABEL->{$metric};
$decoded->{$label} = $CVSS3_METRIC_VALUES->{$metric}->{$value} || $value;
}
}
}
lib/CSAF/Util/CVSS.pm view on Meta::CPAN
if (defined $CVSS2_METRIC_LABEL->{$metric}) {
my $value = $cvss{$metric};
my $label = $CVSS2_METRIC_LABEL->{$metric};
$decoded->{$label} = $CVSS2_METRIC_VALUES->{$metric}->{$value} || $value;
}
}
}
return $decoded;
}
1;
lib/CSAF/Util/CVSS.pm view on Meta::CPAN
=item decode_cvss_vector_string
Decode the provided CVSS (v2.0 or v3.x) vector string.
my $decoded = decode_cvss_vector_string('CVSS:3.1/AV:L/AC:L/PR:N/UI:R/S:U/C:H/I:N/A:L/E:F/RL:O/RC:C');
say $decoded->{attackVector}; # LOCAL
=back
=head1 SUPPORT
view release on metacpan or search on metacpan
lib/CSS/DOM.pm view on Meta::CPAN
If this is specified and set to a true value, then CSS::DOM will treat the
CSS code as a string of bytes, and try to decode it based on @charset rules
and byte order marks.
By default it assumes that it is already in Unicode (i.e., decoded).
=item encoding_hint
Use this to provide a hint as to what the encoding might be.
view release on metacpan or search on metacpan
lib/CSS/Inliner.pm view on Meta::CPAN
# fetch and retrieve the remote content
my ($content,$baseref,$ctcharset) = $self->_fetch_url({ url => $$params{url} });
my $charset = $self->detect_charset({ content => $content, charset => $$params{charset}, ctcharset => $ctcharset });
my $decoded_html;
if ($charset) {
$decoded_html = $self->decode_characters({ content => $content, charset => $charset });
}
else {
# no good hints found, do the best we can
if ($self->_fixlatin()) {
Encoding::FixLatin->import('fix_latin');
$decoded_html = fix_latin($content);
}
else {
$decoded_html = $self->decode_characters({ content => $content, charset => 'ascii' });
}
}
my $html = $self->_absolutize_references({ content => $decoded_html, baseref => $baseref });
$self->read({ html => $html, charset => $charset });
return();
}
lib/CSS/Inliner.pm view on Meta::CPAN
open FILE, "<", $$params{filename} or die $!;
my $content = do { local( $/ ) ; <FILE> };
my $charset = $self->detect_charset({ content => $content, charset => $$params{charset} });
my $decoded_html;
if ($charset) {
$decoded_html = $self->decode_characters({ content => $content, charset => $charset });
}
else {
# no good hints found, do the best we can
if ($self->_fixlatin()) {
Encoding::FixLatin->import('fix_latin');
$decoded_html = fix_latin($content);
}
else {
$decoded_html = $self->decode_characters({ content => $content, charset => 'ascii' });
}
}
$self->read({ html => $decoded_html, charset => $charset });
return();
}
=head2 read
lib/CSS/Inliner.pm view on Meta::CPAN
}
my $content = $$params{content};
my $charset = $$params{charset};
my $decoded_html;
eval {
$decoded_html = decode($charset,$content);
};
if (!$decoded_html) {
croak('Error decoding content with character set "'.$$params{charset}.'"');
}
return $decoded_html;
}
=head2 inlinify
Processes the html data that was entered through either 'read' or
lib/CSS/Inliner.pm view on Meta::CPAN
my ($self,$params) = @_;
$self->_check_object();
# we are going to parse an html document as ascii that is not necessarily ascii - silence the warning
local $SIG{__WARN__} = sub { my $warning = shift; warn $warning unless $warning =~ /^Parsing of undecoded UTF-8/ };
# parse document and pull out key header elements
my $extract_tree = new CSS::Inliner::TreeBuilder();
$self->_configure_tree({ tree => $extract_tree });
view release on metacpan or search on metacpan
lib/CSS/Object.pm view on Meta::CPAN
use CSS::Object;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $resp = $ua->get( $style_uri );
die( $resp->message ) if( $resp->is_error );
my $style = $resp->decoded_content;
my $css = CSS::Object->new;
$css->read_string( $style );
$css->rules->foreach(sub
{
my $rule = shift( @_ );
lib/CSS/Object.pm view on Meta::CPAN
use HTML::Object::XQuery;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $resp = $ua->get( $document_uri );
die( $resp->message ) if( $resp->is_error );
my $html = $resp->decoded_content;
my $parser = HTML::Object->new;
my $doc = $parser->parse( $html ) || die( $parser->error );
my $styles = $doc->find( 'style' ) || die( $doc->error );
say "Nothing found", exit(0) unless( $styles->length > 0 );
my $data = $styles->children->first->text();
view release on metacpan or search on metacpan
lib/CSS/Prepare.pm view on Meta::CPAN
my $resp = $http->get( $url );
my $code = $resp->code();
given ( $code ) {
when ( 200 ) { return $resp->decoded_content(); }
default { return; }
}
}
sub copy_file_to_staging {
my $self = shift;
view release on metacpan or search on metacpan
lib/Cache/Ehcache.pm view on Meta::CPAN
sub get {
my $self = shift;
my ($key) = @_;
my $res = $self->ua->get( $self->_make_url($key) );
if ( $res->is_success ) {
return $res->decoded_content;
}
elsif ( $res->code != HTTP_NOT_FOUND ) {
warn $res->status_line . "\n";
}
}
view release on metacpan or search on metacpan
lib/TSVRPC/Client.pm view on Meta::CPAN
],
method => 'POST',
content => $content,
special_headers => \%special_headers,
);
my $decoded_body;
if (my $content_type = $special_headers{'content-type'}) {
my $res_encoding = TSVRPC::Util::parse_content_type( $content_type );
$decoded_body = defined($res_encoding) ? TSVRPC::Parser::decode_tsvrpc( $body, $res_encoding ) : undef;
}
return ($code, $decoded_body, $msg);
}
1;
__END__
view release on metacpan or search on metacpan
t/11datetime.t view on Meta::CPAN
if($test->{invalid}) {
is($date,undef,"date failed to encode [@{$test->{array}}] correctly");
} else {
ok($date,"date encoded [@{$test->{array}}]");
my @date = decode_date($date);
is_deeply(\@date,$test->{array},"date decoded [@{$test->{array}}]");
}
}
foreach my $test (@diffs) {
my ($date1,$date2);
view release on metacpan or search on metacpan
lib/CallBackery/qooxdoo/callbackery/source/class/callbackery/data/MHistoryRelaxedEncoding.js view on Meta::CPAN
/**
* Decodes a fragment identifier into a string
*
* @param value {String} The fragment identifier
* @return {String} The decoded fragment identifier
*/
_decode: function(value) {
if (qx.lang.Type.isString(value)) {
return decodeURI(value);
}
view release on metacpan or search on metacpan
lib/CanvasCloud/API/Account/Report.pm view on Meta::CPAN
sleep 20; ## sleep 20 seconds and try again
$attempts--;
}
}
die $resp->status_line unless ( $resp->is_success );
return $resp->decoded_content( charset => 'none' );
}
warn sprintf('Report->get ASSERT: id(%s) returned last status (%s)', $result->{id}, $result->{status} );
return undef; ## never should but nothing would be retured
}
view release on metacpan or search on metacpan
lib/Captcha/NocaptchaMailru.pm view on Meta::CPAN
sub _get_json_by_url {
my $agent = LWP::UserAgent->new();
my $resp = $agent->get($_[0]);
return 'request failed' unless $resp->is_success;
my $json = eval {
decode_json($resp->decoded_content);
};
return 'JSON parsing failed' if $@;
return $json;
}
view release on metacpan or search on metacpan
lib/Captcha/reCAPTCHA/V3.pm view on Meta::CPAN
# Enable LWP debugging
use LWP::Debug qw(+);
my $res = $ua->post( $self->{'verify_api'}, $params );
if ( $res->is_success ) {
return decode_json( $res->decoded_content );
} else {
croak $res->status_line;
}
}
lib/Captcha/reCAPTCHA/V3.pm view on Meta::CPAN
The default I<query_name> is 'g-recaptcha-response' and it is stocked in constructor.
But now string-context provides you to get I<query_name> so we don't have to care about it.
The response contains JSON so it returns decoded value from JSON.
unless ( $content->{'success'} ) {
# code for failing like below
die 'fail to verify reCAPTCHA: ', @{ $content->{'error-codes'} }, "\n";
}
view release on metacpan or search on metacpan
lib/Caroline.pm view on Meta::CPAN
my $c = ReadKey(0);
return undef unless defined $c;
return $c unless $IS_WIN32;
# Win32 API always return the bytes encoded with ACP. So it must be
# decoded from double byte sequence. To detect double byte sequence, it
# use Win32 API IsDBCSLeadByte.
require Win32::API;
require Encode;
require Term::Encoding;
$self->{isleadbyte} ||= Win32::API->new(
view release on metacpan or search on metacpan
t/20-meth-decipher.t view on Meta::CPAN
# decipher_child_error() by sub-classing.
#-----
sub decipher_child_error {
my( $self ) = @_;
$self->fixed('decoded');
return;
}
no Moose;
__PACKAGE__->meta->make_immutable;
}
t/20-meth-decipher.t view on Meta::CPAN
#-----
throws_ok{ fatal1 'handler' }
qr{
^
\Q *** Description ***\E \r? \n
\Q decoded\E \r? \n
}xm,
'Subclassed decipher_child_header() overrides base';
}
view release on metacpan or search on metacpan
if (use_hashes) {
HV *this_row = newHV();
av_push(RETVAL, newRV_noinc((SV*)this_row));
for (j = 0; j < col_count; j++) {
SV *decoded = newSV(0);
hv_store_ent(this_row, columns[j].name, decoded, columns[j].name_hash);
decode_cell(aTHX_ ptr, size, &pos, &columns[j].type, decoded);
}
} else {
AV *this_row = newAV();
av_push(RETVAL, newRV_noinc((SV*)this_row));
for (j = 0; j < col_count; j++) {
SV *decoded = newSV(0);
av_push(this_row, decoded);
decode_cell(aTHX_ ptr, size, &pos, &columns[j].type, decoded);
}
}
}
OUTPUT:
view release on metacpan or search on metacpan
lib/Catalyst/Authentication/Credential/Crowd.pm view on Meta::CPAN
return $user;
} else {
$c->stash( auth_error_msg => 'Authenticated user, but could not locate in store!' );
return;
}
} elsif ($response->code == 403 && $response->decoded_content =~ m|<h1>HTTP Status 403 - (.*?)</h1>|i) {
# indicates a tomcat problem, should probably do something else here?
$c->log->warn("Problem comunicating with crowd server: " . $response->code );
$c->stash( auth_error_msg => 'tomcat problem: ' . $1 );
} else {
$c->stash( auth_error_msg => $response->decoded_content );
}
return;
}
view release on metacpan or search on metacpan
lib/Catalyst/Authentication/Store/Crowd.pm view on Meta::CPAN
sub find_user {
my ($self, $info) = @_;
my $response = $self->_crowd_get_user( $info->{username} );
if ( $response->is_success ){
my $crowd_user_info = from_json( $response->decoded_content );
return Catalyst::Authentication::Store::Crowd::User->new({
info => $crowd_user_info
});
}
return;
view release on metacpan or search on metacpan
lib/Catalyst/Controller/DBIC/API.pm view on Meta::CPAN
lazy_build => 1,
);
sub _build__json {
# no ->utf8 here because the request params get decoded by Catalyst
return JSON::MaybeXS->new;
}
with 'Catalyst::Controller::DBIC::API::StoredResultSource',
'Catalyst::Controller::DBIC::API::StaticArguments';
view release on metacpan or search on metacpan
lib/Catalyst/Controller/SimpleCAS/Role/TextTranscode.pm view on Meta::CPAN
## MIME header, but I'm no expert on Unicode). Below we're basically trying
## all of the functions of HTML::Encoding until we find one that gives us
## an answer, and if we do get an answer, we apply it to the MIME object before
## calling ->body_str() which will then use it to decode to text.
##
my $decoded = $MainPart->body; # <-- decodes from base64 (or whatever) to *bytes*
my $char_set =
HTML::Encoding::encoding_from_html_document ($decoded) ||
HTML::Encoding::encoding_from_byte_order_mark ($decoded) ||
HTML::Encoding::encoding_from_meta_element ($decoded) ||
HTML::Encoding::xml_declaration_from_octets ($decoded) ||
HTML::Encoding::encoding_from_first_chars ($decoded) ||
HTML::Encoding::encoding_from_xml_declaration ($decoded) ||
HTML::Encoding::encoding_from_content_type ($decoded) ||
HTML::Encoding::encoding_from_xml_document ($decoded);
$MainPart->charset_set( $char_set ) if ($char_set);
## ------
my $html = $MainPart->body_str; # <-- decodes to text using the character_set
view release on metacpan or search on metacpan
t/lib/TestApp/Controller/Action/Chained.pm view on Meta::CPAN
sub star_search : Chained('view') PathPart('search') Args(0) { }
sub doc_star : Chained('/') PathPart('chained/doc') Args(1) {}
sub return_arg : Chained('view') PathPart('return_arg') Args(1) {}
sub return_arg_decoded : Chained('/') PathPart('chained/return_arg_decoded') Args(1) {
my ($self, $c) = @_;
$c->req->args([ map { decode_entities($_) } @{ $c->req->args }]);
}
sub roundtrip_urifor : Chained('/') PathPart('chained/roundtrip_urifor') CaptureArgs(1) {}
view release on metacpan or search on metacpan
t/live_engine_request_parameters.t view on Meta::CPAN
ok( my $response = request("http://localhost/dump/request?q=foo%2bbar"),
'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
ok( eval '$creq = ' . $response->content );
is $creq->{parameters}->{q}, 'foo+bar', '%2b not double decoded';
}
{
my $creq;
ok( my $response = request("http://localhost/dump/request?q=foo=bar"),
view release on metacpan or search on metacpan
0.06 - 0-10; Beta
Api and internals may still change, but changes are smaller now.
Misc
- Error handling
Handle situation when getting non-decoded content back
- Serializers
Is it possible to send json and receive yaml? Should I handle it?
- Find a way to overwrite request object so it will be possible to use in
controller tests (?)