view release on metacpan or  search on metacpan

perl5db.pl  view on Meta::CPAN

	$fqSubName = 'main::' . $bFunctionName;
    } else {
	$fqSubName = $bFunctionName;
    }
    my @possibleSubNames;
    # First try the direct lookup approach
    if (exists $sub{$fqSubName}) {
	@possibleSubNames = ($fqSubName);
    } elsif (!$isQualified) {
	my ($baseFunctionName) = ($bFunctionName =~ /([^:]+)$/);
	@possibleSubNames = grep(/$baseFunctionName$/, keys %sub);
    } else {
	# postponed
	@possibleSubNames = ($fqSubName);
    }

    # First find all the packages
    return if (!@possibleSubNames);
    my @bkptIDs;
    foreach my $possibleSub (@possibleSubNames) {
	my $addIt = 0;
	my ($fileName, $startLineNo, $endLineNo) = ($sub{$possibleSub} =~ /^(.*):(\d+)-(\d+)$/);
	if ($fileName) {
	    if ($perlFileName) {
		if (lc $fileName eq lc $perlFileName
		    || $fileName =~ /$perlFileName/i) {
		    if (!defined $lineNumber
			|| ($lineNumber >= $startLineNo
			    && $lineNumber <= $endLineNo)) {
			$addIt = 1;
		    }
		}
	    } else {
		$addIt = (!defined $lineNumber
			  || ($lineNumber >= $startLineNo
			      && $lineNumber <= $endLineNo));
	    }
	} elsif ($isQualified) {
	    # postponed
	    $addIt = 1;
	}
	if ($addIt) {
	    my $bFileURINo;
	    my $fileURI = filenameToURI($fileName, 1);
	    my $fileURINo = internFileURI($fileURI);
	    my $bkptID = addSubBreakPoint($possibleSub,
					  $fileURINo,
					  $lineNumber,
					  $bState,
					  $possibleSub,
					  $bCondition,
					  $bType,
					  $bHitCount,
					  $bHitConditionOperator);
	    push @bkptIDs, $bkptID;
	}
    }
    return @bkptIDs;
}

# I try to make the types transparent, but we need to give a typemap
# anyway

sub emitTypeMapInfo($$) {
    my ($cmd, $transactionID) = @_;
    my $res = sprintf(qq(%s\n<response %s %s %s command="%s" 
			 transaction_id="%s" >),
		      xmlHeader(),
		      namespaceAttr(),
		      xsdNamespace(),
		      xsiNamespace(),
		      $cmd,
		      $transactionID);
    # Schema, CommonTypeName (type attr) LanguageTypeName (name attr)
    foreach my $e (['boolean', 'bool'],
		   ['float'],
		   ['integer', 'int'],
		   ['string'],
		   [undef, 'undefined', 'undef'],
		   [undef, 'array', 'ARRAY'],
		   [undef, 'hash', 'HASH']) {
	my $xsdName = $e->[0];
	my $commonTypeName = $e->[1] || $xsdName;
	my $languageTypeName = $e->[2] || $commonTypeName;
	if ($xsdName) {
	    $res .= qq(<map type="$commonTypeName" name="$languageTypeName" xsi:type="xsd:$xsdName"/>);
	} else {
	    $res .= qq(<map type="$commonTypeName" name="$languageTypeName"/>);
	}
    }
    $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);
}