view release on metacpan or  search on metacpan

DB/DbgrProperties.pm  view on Meta::CPAN

# DbgrProperties.pm -- Move all the property-handling code
# into this module.
#
# Copyright (c) 1998-2006 ActiveState Software Inc.
# All rights reserved.
# 
# Xdebug compatibility, UNIX domain socket support and misc fixes
# by Mattia Barbon <mattia@barbon.org>
# 
# This software (the Perl-DBGP package) is covered by the Artistic License
# (http://www.opensource.org/licenses/artistic-license.php).

package DB::DbgrProperties;

use strict qw(vars subs);

our $VERSION = 0.10;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(
	     doPropertySetInfo
	     emitEvalResultAsProperty
	     emitEvaluatedPropertyGetInfo
	     figureEncoding
	     getFullPropertyInfoByValue
	     makeFullPropertyName
	     );
our @EXPORT_OK = ();

use overload;

use DB::Data::Dump;
use DB::DbgrCommon;

# Internal sub declarations

sub adjustLongName($$$);
sub makeFullPropertyName($$);

# And recursively-called exported routines:

sub figureEncoding($);
sub getFullPropertyInfoByValue($$$$$$);

our $ldebug = 0;

# Exported subs

=head1 postconditions

This function does one of three things:

1. Throw an exception: let the caller deal with it, and formulate
an error message.

2. Assign a value to a local value if it's a non-top-level stack
Return undef

3. Return [$property_long_name, undef, 1]
and let the caller do an eval to carry out the assignment.

=cut

sub doPropertySetInfo($$$) {
    my ($cmd,
	$transactionID,
	$property_long_name) = @_;
    
    if (!defined $property_long_name) {
	return makeErrorResponse($cmd,
				 $transactionID,
				 DBP_E_InvalidOption,
				 "-n full-property-name missing");
    } else {
	# In Perl these can be modified.  Setting $_[x] to a value
	# changes the underlying object if it isn't constant.
	# Other changes will be ignored.
	return [$property_long_name, undef, 1];
    }
}

sub emitEvaluatedPropertyGetInfo($$$$$$$) {
    my ($cmd,
	$transactionID,
	$nameAndValue,
	$property_long_name, # For the response things.
	$propertyKey,
	$maxDataSize,
	$pageIndex) = @_;

    my $res = sprintf(qq(%s\n<response %s command="%s" 
			 transaction_id="%s" ),
		      xmlHeader(),
		      namespaceAttr(),
		      $cmd,
		      $transactionID);
    my $finalName = $nameAndValue->[NV_NAME];
    my $finalVal = $nameAndValue->[NV_VALUE];

    $res .= '>' if $cmd ne 'property_value';
    my $startTag = $cmd ne 'property_value' ? '<property' : '';
    my $endTag = $cmd ne 'property_value' ? '</property>' : '';
    $res .= _getFullPropertyInfoByValue($startTag, $endTag,
					$propertyKey || $finalName, # name
					$finalName,
					$finalVal,
					$maxDataSize,
					$pageIndex, # page
					0, # current depth
					);
    $res .= "\n</response>";
    printWithLength($res);
}