view release on metacpan or search on metacpan
DB/MIME/Base64.pm view on Meta::CPAN
=head1 SYNOPSIS
use DB::MIME::Base64::Perl;
$encoded = encode_base64('Aladdin:open sesame');
$decoded = decode_base64($encoded);
=head1 DESCRIPTION
This module provide the same interface as C<DB::MIME::Base64>, but these
functions are implemented in pure perl.
DB/MIME/Base64.pm view on Meta::CPAN
=item decode_base64($str)
Decode a base64 string by calling the decode_base64() function. This
function takes a single argument which is the string to decode and
returns the decoded data.
Any character not part of the 65-character base64 subset is
silently ignored. Characters occurring after a '=' padding character
are never decoded.
=back
=head1 COPYRIGHT
view release on metacpan or search on metacpan
bin/perlbrewise-spec 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
bin/perlbrewise-spec 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
bin/perlbrewise-spec view on Meta::CPAN
$json =~ s/"__proto__"\s*:/"__proto__renamed":/g;
This works because C<__proto__> is not valid outside of strings, so every
occurrence of C<"__proto__"\s*:> must be a string used as property name.
Unicode non-characters between U+FFFD and U+10FFFF are decoded either
to the recommended U+FFFD REPLACEMENT CHARACTER (see Unicode PR #121:
Recommended Practice for Replacement Characters), or in the binary or
relaxed mode left as is, keeping the illegal non-characters as before.
Raw non-Unicode characters outside the valid unicode range fail now to
view release on metacpan or search on metacpan
lib/Devel/IPerl/Display/Role/MIMESource.pm view on Meta::CPAN
return $data;
} elsif( $self->uri ) {
my $ua = LWP::UserAgent->new();
my $response = $ua->get( $self->uri );
die "Could not retrieve data" unless $response->is_success;
my $data = $response->decoded_content;
return $data;
}
die "No data to build display"; # TODO create exception class
}
view release on metacpan or search on metacpan
lib/Devel/PatchPerl/Hints.pm view on Meta::CPAN
=item C<hint_file>
Takes an optional argument which is the OS name ( as would be returned by C<$^O> ).
By default it will use C<$^O>.
In a scalar context, Will return the decoded content of the C<hints> file suitable for writing straight to a
file handle or undef list if there isn't an applicable C<hints> file for the given or derived
OS.
If called in a list context, will return a list, the first item will be the name of the C<hints> file that
will need to be amended, the second item will be a string with the decoded content of the C<hints> file suitable
for writing straight to a file handle. Otherwise an empty list will be returned.
=item C<hints>
Takes no arguments, returns a list of OS names for which there are C<hints> files.
view release on metacpan or search on metacpan
lib/Devel/QuickCover/Report.pm view on Meta::CPAN
sub load {
my ($self, $file) = @_;
my $data = path($file)->slurp_raw;
my $decoded = Sereal::decode_sereal($data);
if (exists $decoded->{files}) {
$self->{data} = $decoded;
} else {
$self->{data} = {
files => $decoded,
metadata => {},
};
}
$self->{changes} = 0;
}
lib/Devel/QuickCover/Report.pm view on Meta::CPAN
sub merge {
my ($self, $file) = @_;
my $json = path($file)->slurp;
my $decoded = decode_json($json);
my $files = $self->{data}{files};
my $subs = $self->{data}{subs};
# I don't think custom merging functions are needed
@{$self->{data}{metadata}}{keys %{$decoded->{metadata}}} =
values %{$decoded->{metadata}};
for my $name (keys %{$decoded->{files}}) {
my $coverage = $decoded->{files}{$name};
for my $line (@{$coverage->{covered}}) {
$files->{$name}->{$line}++;
}
for my $line (@{$coverage->{present}}) {
$files->{$name}->{$line} //= 0;
view release on metacpan or search on metacpan
lib/Devel/StackTrace/AsHTML.pm view on Meta::CPAN
no warnings 'qw';
my %enc = qw( & & > > < < " " ' ' );
# NOTE: because we don't know which encoding $str is in, or even if
# $str is a wide character (decoded strings), we just leave the low
# bits, including latin-1 range and encode everything higher as HTML
# entities. I know this is NOT always correct, but should mostly work
# in case $str is encoded in utf-8 bytes or wide chars. This is a
# necessary workaround since we're rendering someone else's code which
# we can't enforce string encodings.
view release on metacpan or search on metacpan
lib/Devel/StackTrace/AsHTMLExtended.pm view on Meta::CPAN
no warnings 'qw';
my %enc = qw( & & > > < < " " ' ' );
# NOTE: because we don't know which encoding $str is in, or even if
# $str is a wide character (decoded strings), we just leave the low
# bits, including latin-1 range and encode everything higher as HTML
# entities. I know this is NOT always correct, but should mostly work
# in case $str is encoded in utf-8 bytes or wide chars. This is a
# necessary workaround since we're rendering someone else's code which
# we can't enforce string encodings.
view release on metacpan or search on metacpan
t/from-devel-stacktrace/02-bad-utf8.t view on Meta::CPAN
use Devel::StackTrace;
# This should be invalid UTF8
my $raw_bad = do { use bytes; chr(0xED) . chr(0xA1) . chr(0xBA) };
my $decoded = Encode::decode( 'utf8' => $raw_bad );
my $trace = foo($decoded);
my $string = eval { $trace->as_string() };
my $e = $@;
is(
view release on metacpan or search on metacpan
t/02-bad-utf8.t view on Meta::CPAN
use Devel::StackTrace;
# This should be invalid UTF8
my $raw_bad = do { use bytes; chr(0xED) . chr(0xA1) . chr(0xBA) };
my $decoded = Encode::decode( 'utf8' => $raw_bad );
my $trace = foo($decoded);
my $string = eval { $trace->as_string() };
my $e = $@;
is(
view release on metacpan or search on metacpan
src/snappy/csnappy.h view on Meta::CPAN
* REQUIRES: start points to compressed data.
* REQUIRES: n is length of available compressed data.
*
* Returns SNAPPY_E_HEADER_BAD on error.
* Returns number of bytes read from input on success.
* Stores decoded length into *result.
*/
int
csnappy_get_uncompressed_length(
const char *start,
uint32_t n,
view release on metacpan or search on metacpan
lib/Devel/StringInfo.pm view on Meta::CPAN
isa => "Bool",
is => "rw",
default => 0,
);
has include_decoded => (
isa => "Bool",
is => "rw",
default => 1,
);
lib/Devel/StringInfo.pm view on Meta::CPAN
}
sub gather_data_utf8_octets {
my ( $self, $string ) = @_;
my $decoded = decode( utf8 => $string );
my $guessed = sorted_hash $self->gather_data_encoding_info($string);
if ( ($guessed->{guessed_encoding}||'') eq 'utf8' ) {
return (
valid_utf8 => 1,
( $self->include_decoded ? $self->gather_data_decoded( $decoded, $string ) : () ),,
);
} else {
return (
valid_utf8 => 1,
( $self->include_decoded ? (
as_utf8 => sorted_hash($self->gather_data_decoded( $decoded, $string ) ),
as_guess => $guessed,
) : () ),
);
}
}
lib/Devel/StringInfo.pm view on Meta::CPAN
return unless $self->guess_encoding;
my $decoder = Encode::Guess::guess_encoding( $string, $self->encoding_suspects );
if ( ref $decoder ) {
my $decoded = $decoder->decode($string);
return (
guessed_encoding => $decoder->name,
( $self->include_decoded ? $self->gather_data_decoded( $decoded, $string ) : () ),
);
} else {
return (
guess_error => $decoder,
);
}
}
sub gather_data_decoded {
my ( $self, $decoded, $string ) = @_;
if ( $string ne $decoded ) {
return (
decoded_is_same => 0,
decoded => {
string => $decoded,
$self->gather_data($decoded),
}
);
} else {
return (
decoded_is_same => 1,
);
}
}
__PACKAGE__;
lib/Devel/StringInfo.pm view on Meta::CPAN
=item include_value_info
Include some information about the string value (does it contain C<0x00> chars,
is it alphanumeric, does it have newlines, etc).
=item include_decoded
Whether to include a recursive dump of the decoded versions of a non unicode
string.
=item include_hex
Whether to include a L<Data::HexDump::XXD> dump in C<dump_info>.
view release on metacpan or search on metacpan
lib/Devel/hdb/App/Eval.pm view on Meta::CPAN
code => String of Perl code to evaluate
wantarray => 0, 1 or undef; whether to evaluate the code in scalar list
or void context
Returns 200 if successful and the result in the body. The body contents
should be decoded using Data::Transform::ExplicitMetadata
Returns 409 if there was an exception. The body contents should be decoded
using Data::Transform::ExplicitMetadata
=item GET /getvar/<level>
Get a list of all the lexical variables at the given stack level.
lib/Devel/hdb/App/Eval.pm view on Meta::CPAN
@hash{key1,key2} Hash slice
@array[1 .. 2] Array slice with a range
Returns 200 and JSON in the body. The returned JSON is an
encoded version of whatever the Perl code evaluated to, and should
be decoded with Data::Transform::ExplicitMetadata.
=back
=head1 SEE ALSO
view release on metacpan or search on metacpan
bin/avr-updi view on Meta::CPAN
$RESET_REQUIRED++;
print STDERR "Done\n";
}
sub _print_decoded_fields
{
my ( $reg, @fields ) = @_;
while( @fields ) {
my $name = shift @fields;
bin/avr-updi view on Meta::CPAN
make_updi;
my @regs = map { $updi->ldcs( $_ )->get } 0 .. 0x0C;
printf "UPDI.STATUSA = %02X", $regs[0];
_print_decoded_fields $regs[0], UPDIREV => 0xF0;
printf " STATUSB = %02X", $regs[1];
_print_decoded_fields $regs[1], PSIG => 0x0F;
printf " CTRLA = %02X", $regs[2];
_print_decoded_fields $regs[2], IBDLY => (1<<7), PARD => (1<<5), DTD => (1<<4), RSD => (1<<3), GTVAL => 0x07;
printf " CTRLB = %02X", $regs[3];
_print_decoded_fields $regs[3], NACKDIS => (1<<4), CCDETDIS => (1<<3), UPDIDIS => (1<<2);
# [4] to [6] reserved
#
printf " ASI_KEY_STATUS = %02X", $regs[7];
_print_decoded_fields $regs[7], UROWWRITE => (1<<5), NVMPROG => (1<<4), CHIPERASE => (1<<3);
printf " ASI_RESET_REQ = %02X\n", $regs[8];
printf " ASI_CTRLA = %02X", $regs[9];
_print_decoded_fields $regs[9], UPDICLKDIV => 0x03;
printf " ASI_SYS_CTRLA = %02X", $regs[10];
_print_decoded_fields $regs[10], UROWDONE => (1<<1), CLKREQ => (1<<0);
printf " ASI_SYS_STATUS = %02X", $regs[11];
_print_decoded_fields $regs[11], ERASE_FAILED => (1<<6), SYSRST => (1<<5), INSLEEP => (1<<4),
NVMPROG => (1<<3), UROWPROG => (1<<2), LOCKSTATUS => (1<<0);
printf " ASI_CRC_STATUS = %02X", $regs[12];
_print_decoded_fields $regs[12], CRC_STATUS => 0x07;
}
=head2 reset
Sends a reset request.
view release on metacpan or search on metacpan
lib/Device/CableModem/Motorola/SB4200.pm view on Meta::CPAN
my $self = shift;
my $url = shift;
my $r = $self->agent->get($url);
if ( $r->is_success ) {
my $raw = $r->decoded_content;
HTTP::Error::NotFound->throw(
"The address $url is invalid. Server returned a 404 error"
) if $raw =~ RE_404;
return $raw;
}
lib/Device/CableModem/Motorola/SB4200.pm view on Meta::CPAN
my $self = shift;
my $req = shift;
my $r = $self->agent->request($req);
if ( $r->is_success ) {
my $raw = $r->decoded_content;
HTTP::Error::NotFound->throw(
'The request is invalid. Server returned a 404 error'
) if $raw =~ RE_404;
return $raw;
}
view release on metacpan or search on metacpan
lib/Device/Chip/MAX7219.pm view on Meta::CPAN
await $chip->write_raw( $digit, $bits );
Writes the value at the given digit, setting the raw column lines to the 8-bit
value given.
Switches the digit into undecoded raw mode if not already so.
=cut
async method write_raw ( $digit, $bits )
{
view release on metacpan or search on metacpan
lib/Device/Chip/SDCard.pm view on Meta::CPAN
=head2 read_csd
$data = await $card->read_csd;
Returns a C<HASH> reference containing decoded fields from the SD card's CSD
("card-specific data") register.
This hash will contain the following fields:
TAAC
lib/Device/Chip/SDCard.pm view on Meta::CPAN
PERM_WRITE_PROTECT
TEMP_WRITE_PROTECT
FILE_FORMAT
The hash will also contain the following calculated fields, derived from the
decoded fields above for convenience of calling code.
blocks # number of blocks implied by C_SIZE / C_SIZE_MULT
bytes # number of bytes of storage, implied by blocks and READ_BL_LEN
=cut
lib/Device/Chip/SDCard.pm view on Meta::CPAN
=head2 read_ocr
$fields = await $card->read_ocr;
Returns a C<HASH> reference containing decoded fields from the card's OCR
("operating conditions register").
This hash will contain the following fields:
BUSY
view release on metacpan or search on metacpan
lib/Device/Delcom/VSI.pm view on Meta::CPAN
}
=item read_system_variables
Read the system variables. The results are decoded and returned as
a hash reference. The data stored in the hash reference is:
=over 4
=item buzzer_running
lib/Device/Delcom/VSI.pm view on Meta::CPAN
}
=item read_system_variables
Read the formware information. The results are decoded and returned as
a hash reference. The data stored in the hash reference is:
=over 4
=item serial_number
view release on metacpan or search on metacpan
lib/Device/ELM327.pm view on Meta::CPAN
Expand a trouble code (e.g. 4216) to the full ISO code (C0216)
This function is called by 'Read'.
$decoded_code = $obd->DecodeTroubleCode($code);
=cut
sub DecodeTroubleCode
{
my ($self, $code) = @_;
lib/Device/ELM327.pm view on Meta::CPAN
}
my $code_prefix = ($code & $code_prefix_mask) >> 12;
$code &= $code_mask;
$code = sprintf("%03X", $code);
my $decoded_code = "$codes[$code_prefix]$code";
if ($self->{'debug_level'} > 1)
{
print "Code prefix: $code_prefix, Code: $code, Decoded: $decoded_code\n";
}
return $decoded_code;
}
#*****************************************************************
lib/Device/ELM327.pm view on Meta::CPAN
}
}
if ($self->{'debug_level'} > 1)
{
print "\nFully decoded results:\n";
print Dumper($self->{'results'});
}
return $status;
}
view release on metacpan or search on metacpan
lib/Device/Firewall/PaloAlto/API.pm view on Meta::CPAN
return _check_api_response($r);
}
# Checks whether the HTTP response is an error.
# Returns an error object if there's an HTTP error.
# Returns the decoded HTTP content on success.
sub _check_http_response {
my ($http_response) = @_;
if ($http_response->is_error) {
my $err = "HTTP Error: @{[$http_response->status_line]} - @{[$http_response->code]}";
return fatal_error($err, 0);
}
return $http_response->decoded_content;
}
# Parses the API response and checks if it's an API error.
# Returns a data structure representing the XML content on success.
view release on metacpan or search on metacpan
lib/Device/GPIB/Advantest/TR4131.pm view on Meta::CPAN
my $data = $self->sendAndRead('OPTBW'); # Read 701 data points in 1402 bytes
die "Could not read screen data" unless defined $data;
my $length = length($data);
die "Screen data wrong length $length" unless $length == 1402;
my @decoded = unpack("n701", $data);
return @decoded;
}
1;
view release on metacpan or search on metacpan
lib/Device/Gsm.pm view on Meta::CPAN
my($net_name, $net_code) = $gsm->network();
# Returns ('Wind Telecom Spa', '222 88')
This obviously varies depending on country and network operator. For me now,
it holds "Wind Telecomunicazioni SpA". It is not guaranteed that the mobile
phone returns the decoded network name. It can also return a gsm network code,
like C<222 88>. In this case, an attempt to decode the network name is made.
Be sure to call the C<network()> method when already registered to gsm
network. See C<register()> method.
view release on metacpan or search on metacpan
lib/Device/Hue.pm view on Meta::CPAN
if ($res->is_success) {
say $res->status_line
if $self->debug;
say Dumper(decode_json($res->decoded_content))
if $self->debug;
return decode_json($res->decoded_content);
} else {
say "Request failed: " . $res->status_line if $self->debug;
}
return;
view release on metacpan or search on metacpan
lib/Device/Inverter/KOSTAL/PIKO.pm view on Meta::CPAN
$ua->show_progress(1);
}
my $response = $ua->request($request);
croak( "Could not fetch <$url>: " . $response->status_line )
unless $response->is_success;
$response->decoded_content;
}
sub get_current_status {
my $self = shift;
require Device::Inverter::KOSTAL::PIKO::Status;
view release on metacpan or search on metacpan
memory_map_2300.txt view on Meta::CPAN
047A 0 Start your read at 0479. Read 2 sets of 15.
047B 0 Store as a 30 byte array.
047C 0 What this is, is a rolling queue
047D 0 Each "impulse" is 0.0204" or 0.51826mm of rain.
047E 0 This measurement is simply (# impulses * unitOfMeasure)
047F 0 Exact encoding not yet decoded
0480 0 Rain 1h area
0481 0 Rain 1h area
0482 0 Rain 1h area
0483 0 Rain 1h area
0484 0 Rain 1h area
view release on metacpan or search on metacpan
lib/Device/Modem/UsRobotics.pm view on Meta::CPAN
=head1 WARNING
This module is not documented yet, and it is a rough work in progress.
Until now, it correctly reads voice/fax messages information, but when
saving voice messages to disk, sometimes they are incorrectly decoded.
So, if you need a working program, check out the good old TkUsr by
Ludovic Drolez, unless you want to help develop Device::Modem::UsRobotics.
=head1 DOCS TO BE COMPLETED FROM NOW.....
view release on metacpan or search on metacpan
lib/Device/Nest.pm view on Meta::CPAN
my $response = $self->{'ua'}->get($self->{'device_url'});
$self->{'last_code'} = $response->code;
if ($response->is_success) {
my $decoded_response = decode_json($response->content);
my $designation = ($decoded_response->{'thermostats'});
my @designation2 = keys(%$designation);
$self->{'thermostat'} = $designation2[0];
$self->{'thermostat_url'} = "https://developer-api.nest.com/devices/thermostats/".$self->{'thermostat'};
print "Thermostat designation: ".$self->{'thermostat'}."\n" if ($self->{'debug'});
my $response = $self->{'ua'}->get("https://developer-api.nest.com/structures?auth=".$self->{'auth_token'});
$self->{'last_code'} = $response->code;
if ($response->is_success) {
my $decoded_response = decode_json($response->content);
my @designation = keys(%$decoded_response);
$self->{'structure'} = $designation[0];
$self->{'struct_url'} = "https://developer-api.nest.com/structures/".$self->{'structure'}."?auth=".$self->{'auth_token'};
print "Structure Designation: ".$self->{'structure'}."\n" if ($self->{'debug'});
return 1;
} else {
lib/Device/Nest.pm view on Meta::CPAN
my $response = $self->{'ua'}->get($self->{'struct_url'});
$self->{'last_code'} = $response->code;
if ($response->is_success) {
my $decoded_response = decode_json($response->content);
return $decoded_response->{'away'};
} else {
print "Nest->fetch_Away_State(): Failed with return code ".$self->get_last_code()."\n";
return 0;
}
}
lib/Device/Nest.pm view on Meta::CPAN
my $response = $self->{'ua'}->get($self->{'struct_url'});
$self->{'last_code'} = $response->code;
if ($response->is_success) {
my $decoded_response = decode_json($response->content);
return $decoded_response->{$self->{'structure'}}->{'country_code'};
} else {
print "Nest->fetch_Country_Code(): Failed with return code ".$self->get_last_code()."\n";
return 0;
}
}
lib/Device/Nest.pm view on Meta::CPAN
$self->{'last_exec_time'} = eval{($time_after-$time_before)*1000};
$self->{'last_code'} = $response->code;
if ($response->is_success) {
my $decoded_response = decode_json($response->content);
# print Dumper($decoded_response);
return $decoded_response->{'thermostats'}->{$self->{'thermostat'}}->{$tag};
} else {
print "\n".(caller(1))[3]."(): Failed with return code ".$self->get_last_code()."\n";
return 0;
}
}
view release on metacpan or search on metacpan
lib/Device/PaloAlto/Firewall.pm view on Meta::CPAN
sub _get_pa_response {
my $self = shift;
my $http_response = shift;
my $xml_parser = XML::Twig->new();
my $pa_response_twig = $xml_parser->safe_parse( $http_response->decoded_content );
if (!$pa_response_twig) {
carp "Invalid XML returned from firewall";
return;
}
view release on metacpan or search on metacpan
lib/Device/RFXCOM/Response.pm view on Meta::CPAN
=over
=item unknown
for a message that could not be decoded
=item version
for a response to a version check request
view release on metacpan or search on metacpan
lib/Device/RadioThermostat.pm view on Meta::CPAN
sub _ua_post {
my ( $self, $path, $data ) = @_;
my $response
= $self->{ua}->post( $self->{address} . $path, content => encode_json $data );
if ( $response->is_success ) {
my $result = decode_json $response->decoded_content();
# return $result;
return exists( $result->{success} ) ? 1 : 0;
}
else {
lib/Device/RadioThermostat.pm view on Meta::CPAN
sub _ua_get {
my ( $self, $path ) = @_;
my $response = $self->{ua}->get( $self->{address} . $path );
if ( $response->is_success ) {
return decode_json $response->decoded_content();
}
else {
my ($code, $err) = ($response->code, $response->message);
carp $code ? "$code response: $err" : "Connection error: $err";
return;
view release on metacpan or search on metacpan
lib/Device/TLSPrinter.pm view on Meta::CPAN
raw printer status as a string
=item
decoded printer status as a hash
=back
B<Example>
lib/Device/TLSPrinter.pm view on Meta::CPAN
raw cell status as a string
=item *
decoded cell status as a hash
=back
B<Example>