view release on metacpan or  search on metacpan

lib/DMTF/CIM/WSMan.pm  view on Meta::CPAN

					return;
				}
				$obj->uri($self->_parse_reference($epr));
				push @{$ret},$obj;
			}
		}
	}
	return @{$ret};
}

sub _XML_escape
{
	my $val=shift;
	$val=~s/&/&/g;
	$val=~s/</&lt;/g;
	$val=~s/"/&quot;/g;
	$val=~s/'/&apos;/g;
	return $val;
}

sub _instance_to_XML
{
	my $self=shift;
	my $obj=shift;
	my $ret='';
	my $class=$obj->class;
	my $wsman=$self->current_wsman;

	$ret.="<p:$class xmlns:p=\"http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/$class\">";
	foreach my $prop (sort { $a->name cmp $b->name } $obj->defined_properties) {
		my $val;
		if($prop->is_array) {
			$val=[$prop->value];
		}
		else {
			$val=$prop->value;
		}
		my $octetstring=$prop->qualifier('octetstring');
		if(defined $octetstring
				&& $octetstring eq 'true'
				&& $prop->type =~ /(uint8|string)\[\]/) {
			if($1 eq 'string') {
				if(ref($val) eq 'ARRAY') {
					foreach my $value (@$val) {
						my $v=uc(unpack("H*",$value));
						$v = sprintf('0x%08X%s',((length($v)/2)+4),$v) if($self->{QUIRKS}{incorrect_string_octetstring});
						$ret .= "<p:".($prop->name).">$v</p:".($prop->name).">";
					}
				}
				else {
					if($self->{QUIRKS}{incorrect_string_octetstring}) {
						$val = sprintf('0x%08X%s',(length($val)+4),uc(unpack("H*",$val)));
					}
					else {
						$val = uc(unpack("H*",$val));
					}
					$ret .= "<p:".($prop->name).">".$val."</p:".($prop->name).">";
				}
			}
			else {
				my $decoded;
				if(ref($val) eq 'ARRAY') {
					$decoded=join('',@{$val});
				}
				else {
					$decoded=$val;
				}
				$ret .= "<p:".($prop->name).">".encode_base64($decoded)."</p:".($prop->name).">";
			}
		}
		elsif(ref($val) eq 'ARRAY') {
			foreach my $value (@$val) {
				if($prop->is_ref) {
					$value=$wsman->epr_to_xml($self->URItoEPR(URI->new($value)));
				}
				elsif($prop->type eq 'datetime') {
					$value="<$wsman->{Context}{cim}{prefix}:CIM_DateTime>$value</$wsman->{Context}{cim}{prefix}:CIM_DateTime>";
				}
				$ret .= "<p:".($prop->name).">"._XML_escape($value)."</p:".($prop->name).">";
			}
		}
		else {
			if($prop->is_ref) {
				$val=$wsman->epr_to_xml($self->URItoEPR(URI->new($val)));
			}
			elsif($prop->type eq 'datetime') {
				$val="<$wsman->{Context}{cim}{prefix}:CIM_DateTime>$val</$wsman->{Context}{cim}{prefix}:CIM_DateTime>";
			}
			$ret .= "<p:".($prop->name).">"._XML_escape($val)."</p:".($prop->name).">";
		}
	}
	$ret.="</p:$class>";
}

sub _params_to_XML
{
	my $self=shift;
	my $class=shift;	# A class definition from the model
	my $method=shift;
	my $lcm=lc($method);
	my $params=shift;	# Hashref containg scalars and arrayrefs
	my $ret='';
	my $wsman=$self->current_wsman;

	$ret.="<p:$method\_INPUT xmlns:p=\"http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/$class->{name}\">";
	foreach my $param (sort keys %{$params}) {
		my $paramdef=$class->{methods}{$lcm}{parameters}{lc($param)};
		if(!defined $paramdef) {
			carp("Undefined parameter $param passed to $method method of $class->{name}");
			return;
		}
		if(!defined $paramdef->{type}) {
			carp("Unknown type for parameter $paramdef->{name} passed to $method of $class->{name}");
			return;
		}

		my $val=$params->{$param};

		if(ref($val) eq 'ARRAY') {
			foreach my $value (@$val) {
				if($paramdef->{type} eq 'ref') {
					$value=$wsman->epr_to_xml($self->URItoEPR(URI->new($value)));
				}
				elsif($paramdef->{type} eq 'datetime') {
					$value="<$wsman->{Context}{cim}{prefix}:CIM_DateTime>$value</$wsman->{Context}{cim}{prefix}:CIM_DateTime>";
				}
				$ret .= "<p:$paramdef->{name}>$value</p:$paramdef->{name}>";
			}

lib/DMTF/CIM/WSMan.pm  view on Meta::CPAN

				$tz="+00:00" if $tz eq 'Z';
				if($tz=~/^([-+])([0-9]{2}):([0-9]{2})$/) {
					my ($sign,$hour,$min)=($1,$2,$3);
					$tz=$hour*60+$min;
					$tz=0-$tz if $sign eq '-';
					my $dt=sprintf("********%02d%02d%02d%s%+02d",$h,$m,$s,$fs,$tz);
					return wantarray ? ($dt,'datetime') : $dt;
				}
				else {
					carp("Unrecognized timezone $tz");
					return;
				}
			}
			else {
				carp("Unrecognized date representation $val");
				return;
			}
		}
		elsif($type eq 'c:Datetime') {
			my $val=$child->text;
			$val =~ s/^\s*(.*?)\s*$/$1/;
			if($val =~ /^(-?[0-9]{4,})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})(\.[0-9]+)?(Z|(?:[-+][0-9]{2}:[0-9]{2}))?$/) {
				my ($y,$m,$d,$h,$min,$s,$fs,$tz)=($1,$2,$3,$4,$5,$6,$7,$8);
				if($y < 0) {
					carp("CIM cannot model dates BC ($val)");
					return;
				}
				$fs=0 unless defined $fs;
				$fs=substr(sprintf("%0.6f",$fs),1);
				$tz="+00:00" if $tz eq 'Z';
				if($tz=~/^([-+])([0-9]{2}):([0-9]{2})$/) {
					my ($sign,$hour,$min)=($1,$2,$3);
					$tz=$hour*60+$min;
					$tz=0-$tz if $sign eq '-';
					my $dt=sprintf("%04d%02d%02d%02d%02d%02d%s%+02d",$y,$m,$d,$h,$min,$s,$fs,$tz);
					return wantarray ? ($dt,'datetime') : $dt;
				}
				else {
					carp("Unrecognized timezone $tz");
					return;
				}
			}
			else {
				carp("Unrecognized date representation $val");
				return;
			}
		}
		else {
			carp("Unhandled data type $type in EPR Selector");
			return;
		}
	}
	else {
		if(defined $model
				&& defined $model->{qualifiers}
				&& defined $model->{qualifiers}{octetstring}
				&& $model->{qualifiers}{octetstring} eq 'true') {
			if(defined $model->{type}
					&& $model->{type} eq 'uint8'
					&& defined $model->{array}) {
				my $decoded=decode_base64($twig->text);
				return wantarray ? ($decoded, 'bytes') : $decoded;
			}
			if(defined $model->{type}
					&& $model->{type} eq 'string'
					&& defined $model->{array}) {
				my $encoded=$twig->text;
				$encoded=~s/([0-9A-Fa-f]{2})/chr(hex($1))/eg;
				if($self->{QUIRKS}{incorrect_string_octetstring}) {
					$encoded =~ s/^0x[0-9a-fA-F]{8}//;
				}
				return $encoded;
			}
		}
		return $twig->text;
	}
}

sub _parse_reference
{
	my $self=shift;
	my $reference=shift;
	my $ns='interop';
	my $authority;
	my $scheme='wsman.wbem';
	my $path;
	my $class;

	my $rp=$reference->first_child('a:ReferenceParameters');
	if(!defined $rp) {
		carp("No reference parameters in EPR");
		return;
	}
	my $ruri=$rp->first_child('w:ResourceURI')->text;
	if(!defined $ruri) {
		carp("Unable to locate ResourceURI in EPR");
		return;
	}
	if($ruri=~/^.*\/([^\/]+)$/) {
		$class=$1;
	}
	if(!defined $class) {
		carp("Unable to parse class from uri $ruri");
	}
	$self->class_tag_alias($class, lc($class));
	my $ss=$reference->first_child('a:ReferenceParameters')->first_child('w:SelectorSet');
	if(defined $ss) {
		my %vals;
		for(my $sel=$ss->first_child('w:Selector');defined $sel;$sel=$sel->next_sibling('w:Selector')) {
			my $name=$sel->att('Name');
			if(!defined $name) {
				carp("Missing selector name in EPR");
				return;
			}
			if($name eq '__cimnamespace') {
				$ns=$sel->text;
			}
			else {
				$vals{$name}=$self->_stringify($sel);
			}
		}
		foreach my $val (sort keys %vals) {