Devel-Debug-DBGp
view release on metacpan or search on metacpan
DB/MIME/Base64.pm view on Meta::CPAN
=head1 NAME
DB::MIME::Base64::Perl - Encoding and decoding of base64 strings
=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.
This module provides functions to encode and decode strings into and from the
base64 encoding specified in RFC 2045 - I<MIME (Multipurpose Internet
Mail Extensions)>. The base64 encoding is designed to represent
arbitrary sequences of octets in a form that need not be humanly
DB/MIME/Base64.pm view on Meta::CPAN
line-ending sequence to use. It is optional and defaults to "\n". The
returned encoded string is broken into lines of no more than 76
characters each and it will end with $eol unless it is empty. Pass an
empty string as second argument if you do not want the encoded string
to be broken into lines.
=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
Copyright 1995-1999, 2001-2004 Gisle Aas.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
}
}
$res .= "\n</response>";
printWithLength($res);
}
sub decodeCmdLineData($$$$) {
my ($cmd, $transactionID, $dataLength, $argsARef) = @_;
my @args = @$argsARef;
my $currDataEncoding = $settings{data_encoding}->[0];
my $decodedData;
if ($currDataEncoding eq 'none' || $currDataEncoding eq 'binary') {
$decodedData = join(" ", @args);
$dataLength = length ($decodedData);
} elsif (scalar @args == 0) {
printWithLength(sprintf
qq(%s\n<response %s command="%s" transaction_id="%s" ><error code="%d" apperr="4"><message>Expecting exactly 1 argument for %s command, got [nothing].</message></error></response>),
xmlHeader(),
namespaceAttr(),
$cmd,
$transactionID,
DBP_E_CommandUnimplemented,
$cmd,
);
return ();
} else {
$decodedData = decodeData(join("", @args));
$dataLength = length ($decodedData);
}
dblog("decodeCmdLineData: returning [$decodedData]\n") if $ldebug;
return ($dataLength, $currDataEncoding, $decodedData);
}
sub checkForEvalStackType($) {
my ($stackDumpTypeValue) = @_;
if ($stackDumpTypeValue && $stackDumpTypeValue =~ /^eval [\"\'q<]/) {
return 'eval';
} else {
return 'file';
}
}
} elsif ($bType eq 'conditional') {
if (!defined $bLine) {
$bptErrorCode = DBP_E_InvalidOption;
$bptErrorMsg = "Line number required for setting a conditional breakpoint in Perl.";
} else {
$bType = 'line';
if ($cmdArgs[0] && length $cmdArgs[0]) {
$bCondition = $cmdArgs[0];
dblog("Got raw condition [$bCondition]") if $ldebug;
$bCondition = decodeData($bCondition);
dblog("Got decoded condition [$bCondition]") if $ldebug;
} else {
$bptErrorCode = DBP_E_InvalidOption;
$bptErrorMsg = "Condition required for setting a conditional breakpoint.";
}
}
} elsif ($bType eq 'watch') {
my $bptErrorCode = 0;
my $bptErrorMsg;
if ($cmdArgs[0] && length $cmdArgs[0]) {
$bCondition = $cmdArgs[0];
dblog("Got raw condition [$bCondition]") if $ldebug;
$bCondition = decodeData($bCondition);
dblog("Got decoded condition [$bCondition]") if $ldebug;
if ($bCondition) {
$evalarg = $bCondition;
my ($val) = eval { join(' ', &eval) };
$val = (defined $val) ? "'$val'" : 'undef';
push @watchPoints, $bCondition;
push @watchPointValues, $val;
# We are now watching expressions.
$trace |= 2;
++$numWatchPoints;
}
my $valueType = $opts{t};
if ($context_id == FunctionArguments) {
makeErrorResponse($cmd,
$transactionID,
DBP_E_CantSetProperty,
"This debugger currently doesn't modify function arguments");
next CMD;
}
my ($actualDataLength, $currDataEncoding, $decodedData);
if (scalar @cmdArgs) {
($actualDataLength, $currDataEncoding, $decodedData) =
decodeCmdLineData($cmd, $transactionID, $advertisedDataLength, \@cmdArgs);
}
if (!defined $decodedData) {
dblog("property_set: \$decodedData not defined\n") if $ldebug;
makeErrorResponse($cmd,
$transactionID,
DBP_E_CantSetProperty,
"Can't decode the data");
next CMD;
}
if ($valueType
&& $valueType eq 'string'
&& substr($decodedData, 0, 1) !~ /[\"\']/) {
$decodedData =~ s,\\,\\\\,g;
$decodedData =~ s,',\\',g;
$decodedData = "\'$decodedData\'";
}
my $nameAndValue = doPropertySetInfo($cmd,
$transactionID,
$property_long_name);
if (!$nameAndValue) {
# Already gave an error message
next CMD;
}
if ($nameAndValue->[NV_NEED_MAIN_LEVEL_EVAL]) {
$evalarg = $nameAndValue->[NV_NAME] . '=' . $decodedData;
# here we don't adjust $evalSkipFrames because
# modifying function arguments is not supported
eval {
&eval();
};
if ($@) {
# dblog("Have to deal with error [$@]\n") if $ldebug;
# Fix $@;
my ($code, $error) = ($@ =~ /code:(.*):error<:<(.*?)>:>/);
if (!$code) {
"stdin not supported via protocol");
} elsif ($cmd eq 'eval') {
my %opts;
{
local *ARGV = \@cmdArgs;
shift @ARGV;
getopts('l:p:', \%opts);
}
my $dataLength = $opts{l};
my $pageIndex = $opts{p} || 0;
my ($actualDataLength, $currDataEncoding, $decodedData);
if (scalar @cmdArgs) {
($actualDataLength, $currDataEncoding, $decodedData) =
decodeCmdLineData($cmd, $transactionID, $dataLength, \@cmdArgs);
}
if (!defined $decodedData) {
next CMD;
}
eval {
local $evalSkipFrames = $evalSkipFrames + 1;
my $res = eval_term($decodedData);
emitEvalResultAsProperty($cmd,
$transactionID,
$decodedData,
$res,
$settings{max_data}[0],
$pageIndex);
1;
} or do {
my $error = $@ || "";
makeErrorResponse($cmd, $transactionID, DBP_E_PropertyEvalError, "Error in eval: $error")
};
} else {
( run in 0.283 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )