view release on metacpan or  search on metacpan

lib/Broadworks/OCIP.pm  view on Meta::CPAN

            my $confset = Config::Any->load_files( { files => [$fn], use_ext => 1 } );
            unless ($confset) {
                Broadworks::OCIP::Throwable->throw(
                    message         => sprintf( "Unable to handle config file %s - %s", $fn, $! ),
                    execution_phase => 'buildargs',
                    error_code      => 'no_config'
                );
            }
            my $config = ( values( %{ $confset->[0] } ) )[0]
                or Broadworks::OCIP::Throwable->throw(
                message         => sprintf( "No valid config file %s - %s", $fn, $! ),
                execution_phase => 'buildargs',
                error_code      => 'invalid_config'
                );

            $args = $config->{'Broadworks::OCIP'}
                or Broadworks::OCIP::Throwable->throw(
                message         => sprintf( "No Broadworks::OCIP section in config file %s", $fn ),
                execution_phase => 'buildargs',
                error_code      => 'duff_config'
                );
        }
        else {
            # single reference argument - treat as a hash ref
            $args = $_[0];
        }
    }
    else {    # just make some args up
        $args = {@_};
    }

    # convert password to authhash
    if ( my $password = delete $args->{password} ) {
        $args->{authhash} = lc( sha1_hex($password) );
    }

    $class->$orig($args);
};

# ----------------------------------------------------------------------


method send ($string) {

    $self->last_sent($string);
    $self->socket->print( $self->encoder->encode($string) );
    warn( '>>> ', $string, "\n" ) if ( $self->trace );
}

# ----------------------------------------------------------------------


method receive ($expected,$die_on_error) {

    my $bytes = '';
    {    # delimit section where we override character handling
        use bytes;
        my $select = $self->select;
        while ( my ($fh) = $select->can_read( $self->{timeout} ) ) {
            Broadworks::OCIP::Throwable->throw(
                message         => "Timeout on receive for [$expected] - $!\n",
                execution_phase => 'receive',
                error_code      => 'timeout'
            ) unless ( defined($fh) );

            # read - bail out if EOF
            my $eofs = 0;
            unless ( sysread $fh, $bytes, 65536, length($bytes) ) {
                last if ( $eofs++ );
                next;
            }
            last if ( $bytes =~ /<\/BroadsoftDocument>/ );
        }

        Broadworks::OCIP::Throwable->throw(
            message         => "No Data on receive - $!\n($bytes)\n",
            execution_phase => 'receive',
            error_code      => 'no_data'
        ) unless ( length($bytes) );
    }

    # convert string from cruddy encoding to utf8
    my $str = $self->encoder->decode($bytes);
    warn( '<<< ', $str, "\n" ) if ( $self->trace );

    # we rely on the XML decoder handling any character set issues correctly!
    return ( Broadworks::OCIP::Response->new( xml => $str, expected => $expected, die_on_error => $die_on_error ) );
}

# ----------------------------------------------------------------------
sub _command_xml_parameters {
    my ( $xw, $parampairs ) = @_;

    while ( scalar( @{$parampairs} ) ) {
        my ( $key, $val ) = splice( @{$parampairs}, 0, 2 );
        if ( ref($val) eq 'ARRAY' ) {
            $xw->startTag($key);
            _command_xml_parameters( $xw, $val );
            $xw->endTag($key);
        }
        else {

            # attribs is there to allow correct tagging of empty elements
            my @attribs = ( defined($val) && ( $val eq qq[] ) ) ? ( 'xsi:nil' => 'true' ) : ();
            $xw->dataElement( $key => $val, @attribs );
        }
    }
}

# ----------------------------------------------------------------------


method send_command_xml ($cmd, $parampairs) {

    # start XML build
    my $xw = XML::Writer->new( OUTPUT => 'self' )
        or Broadworks::OCIP::Throwable->throw(
        message         => "Cannot build XML object - $!",
        execution_phase => 'send',
        error_code      => 'xml_fail'
        );