File Coverage

blib/lib/Net/DSML/Control.pm

Criterion	Covered	Total	%
statement	111	143	77.6
branch	58	74	78.3
condition	23	36	63.8
subroutine	13	14	92.8
pod	5	5	100.0
total	210	272	77.2

package Net::DSML::Control;

use warnings;
use strict;
#use Carp;
use Class::Std::Utils;

# Copyright (c) 2007 Clif Harden . All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use version; $VERSION = version->new('0.002');

{

BEGIN
{
  use Exporter ();

  @ISA = qw(Exporter);
  @EXPORT = qw();
  %EXPORT_TAGS = ();
  @EXPORT_OK  = ();
}

my %errMsg;        # no error this will be a null string.
my %controls;      # Actual xml data string.
my %default;       # will contain the initial control string if there is one.
#
# Method new
#
# The method new creates a new DSML Control oject.
#
# There are four possible input options.
# Input option "control":   Sets the oid number of the control
# Input option "value":  Sets the control value data.
# Input option "valuetype":    Sets the xsd type for the control value.
# Input option "criticality":   Sets the criticality variable to the input
# value, either true or false.
#
#
# $control = Net::DSML::Control->new( { control => 1.2.840.113556.1.4.619,
#                                       valuetype => base64Binary,
#                                       criticality => true,
#                                       value => RFNNTYyLJA==  } );
#
# Method output;  Returns a new DSML object.
#

sub new
{
  my ($class, $opt) = @_;
  my $self = bless anon_scalar(),$class;
  my $id = ident($self);
  my $result;
  my $value;
  my $valuetype;
  my $criticality;
  my $control;
  #
  # Initailize data to a default values.
  #
  $errMsg{$id} = "";     # no error
  $controls{$id}   = []; # Actual control xml data string(s).
  $default{$id}->{default} = "";

  if ( $opt )
  {

  if ( !defined($opt->{control}) )
  {
    $errMsg{$id} = "Subroutine Control required type oid value is not defined.";
    return $self;
  }

  $control = (ref($opt->{control}) ? ${$opt->{control}} : $opt->{control});
  $valuetype = (ref($opt->{valuetype}) ? ${$opt->{valuetype}} : $opt->{valuetype}) if ( $opt->{valuetype});
  $criticality = (ref($opt->{criticality}) ? ${$opt->{criticality}} : $opt->{criticality}) if ( $opt->{criticality});
  $value = (ref($opt->{value}) ? ${$opt->{value}} : $opt->{value});

  if ( $opt->{criticality} && !($criticality =~ /^(true)||(false)$/) )
  {
    $errMsg{$id} = "The Control`s criticality is not defined properly.";
    return $self;
  }

  if ( $opt->{valuetype} && !($valuetype =~ /^(string)||(anyURI)||(base64Binary)$/) )
  {
    $errMsg{$id} = "The Control`s valuetype is not defined properly.";
    return $self;
  }

  if (  $opt->{value} && !$opt->{valuetype})
  {
    $errMsg{$id} = "The value data was defined but the valuetype of the value data was not not defined.";
    return $self;
  }

  if ( $opt->{type} && !$opt->{value})
  {
    $errMsg{$id} = "The valuetype was defined but the value data was not not defined.";
    return $self;
  }

  if ( $opt->{value} )
  {
    _specialChar(\$value) if ( $value =~ /(&||<||>||"||')/);
  }

  $result = "
  $result .= " critical=\"" . $criticality . "\"" if ( $opt->{criticality});
  $result .= ">";
  $result .=  "{value});
  $result .= "xsi:type=\"xsd:" . $valuetype . "\"" if ( $opt->{value} && $opt->{valuetype});
  $result .= ">" if ( $opt->{value} && $opt->{valuetype});
  $result .= $value . "" if ($opt->{value});
  $result .= "";

  push(@{$controls{$id}}, $result);
  $default{$id}->{default} = $result;
  }

return $self;
}

#
# inside-out classes have to have a DESTROY subrountine.
#
sub DESTROY
{
  my ($dsml) = @_;
  my $id = ident($dsml);

  delete $controls{$id};      # Copy of actual xml data string.
  delete $default{$id};       # Copy of actual xml data string.
  delete $errMsg{$id};        # no error this will be a null string.
  return;
}

#
# The method clear sets object variables to their default values.
#
# Returns true on success.
#

sub clear
{
  my ($dsml) = shift;
  my $id = ident $dsml;

  $controls{$id} = [];  # Actual xml data string.
  $errMsg{$id}   = "";  # error messages, no error this will be a null string.
  push(@{$controls{$id}}, $default{$id}->{default});
  return 1;
}

#   1.  & - &
#   2. < - <
#   3. > - >
#   4. " - "
#   5. ' - '
#
#   Convert special characters to xml standards.
#
sub _specialChar
{
  my ($char) = @_;

  $$char =~ s/&/&/g;
  $$char =~ s/
  $$char =~ s/>/>/g;
  $$char =~ s/"/"/g;
  $$char =~ s/'/'/g;
  return;
}

#
# Method error
#
# The method error returns the error message for the object.
# $message = $dsml->error();
#

sub error
{
  my $dsml = shift;
  return $errMsg{ident $dsml};
}

# Method add
#
# The method Add is used in conjuction with other methods like Search.
#
# If there is one required input option and 3 additional optional options.
#
# $return = $control->Add( { control => 1.2.840.113556.1.4.619, valuetype => base64Binary, criticality => true, value => RFNNTYyLJA==  } );
#
# Input option "control":  The control oid number.
# Input option "valuetype":  The xsd type for the value data.
# Input option "criticality":  The criticality of the control; true or false.
# Input option "value":  The value of the control.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub add
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $result;
  my $value;
  my $valuetype;
  my $criticality;
  my $control;

  $errMsg{$id} = "";
  if ( !defined($opt->{control}) )
  {
    $errMsg{$id} = "Method add control required oid value is not defined.";
    return 0;
  }

  $control = (ref($opt->{control}) ? ${$opt->{control}} : $opt->{control});
  $valuetype = (ref($opt->{valuetype}) ? ${$opt->{valuetype}} : $opt->{valuetype}) if ( $opt->{valuetype});
  $criticality = (ref($opt->{criticality}) ? ${$opt->{criticality}} : $opt->{criticality}) if ( $opt->{criticality});
  $value = (ref($opt->{value}) ? ${$opt->{value}} : $opt->{value});


  if ( $opt->{criticality} && !($criticality =~ /^(true)||(false)$/) )
  {
    $errMsg{$id} = "Method add Control criticality is not defined properly.";
    return 0;
  }

  if ( $opt->{valuetype} && !($valuetype =~ /^(string)||(anyURI)||(base64Binary)$/) )
  {
    $errMsg{$id} = "Method add control`s valuetype is not defined properly.";
    return 0;
  }

  if (  $opt->{value} && ! $opt->{valuetype})
  {
    $errMsg{$id} = "Method control valuetype for the value data was not not defined.";
    return 0;
  }

  if ( $opt->{valuetype} && !$opt->{value})
  {
    $errMsg{$id} = "Method add control`s valuetype was defined but the value data was not not defined.";
    return 0;
  }

  if ( $opt->{value} )
  {
    _specialChar(\$value) if ( $value =~ /(&||<||>||"||')/);
  }

  $result = "
  $result .= " critical=\"" . $criticality . "\"" if ( $opt->{criticality});
  $result .= ">";
  $result .=  "{value});
  $result .= "xsi:type=\"xsd:" . $valuetype . "\"" if ( $opt->{value} && $opt->{valuetype});
  $result .= ">" if ( $opt->{value} && $opt->{valuetype});
  $result .= $value . "" if ($opt->{value});
  $result .= "";

  push(@{$controls{$id}}, $result);
  return 1;
}

sub getControl
{
  my ($dsml) = @_;
  my $id = ident $dsml;
  my $result;
  $result = "";

  foreach my $var (@{$controls{$id}})
  {
     $result .= $var;
  }

  return $result;
}

}

1; # Magic true value required at end of module

__END__