Net::MarkLogic::XDBC - XDBC connectivity for MarkLogic CIS servers.

  use Net::MarkLogic::XDBC

  $xdbc = Net::MarkLogic::XDBC->new( "user:pass@localhost:9000" );

  $xdbc = Net::MarkLogic::XDBC->new(host     => $host,
                                    port     => $port,
                                    username => $user,
                                    password => $pass, );

  $result = $agent->query($xquery);

  print $result->content;

  @items = $result->items;
  print $item->content;

  $xdbc = Net::MarkLogic::XDBC->new( "user:pass@localhost:9000" );

  $xdbc = Net::MarkLogic::XDBC->new( host     => $hostname,
                                     port     => $port,
                                     username => $user,
                                     password => $pass, );

    $result = $xdbc->query($xquery);

    $result = $xdbc->query_from_template($template, $args);

    Tony Stubblebine
    tonys@oreilly.com

    Code contributions from: Michael Blakeley

    Advice and comments from Raffaele Sena, Ryan Grimm, Andy Bruno.

    http://www.apache.org/licenses/LICENSE-2.0

package Net::MarkLogic::XDBC;

use strict;
use warnings;

use Data::Dumper;
use LWP::UserAgent;
use Class::Accessor;
use Class::Fields;
use URI::Escape;
use Template;

use Net::MarkLogic::XDBC::Result;

our $VERSION     = 0.11;

our @BASIC_FIELDS = qw(host port username password uri);
our @REQUIRED_FIELDS = qw(host port username password);

use base qw(Class::Accessor Class::Fields);
use fields @BASIC_FIELDS, qw(ua header template);
Net::MarkLogic::XDBC->mk_accessors( @BASIC_FIELDS );

sub new
{
    my $class = shift;
    
    my %args;
    
    if (scalar @_ == 1)
    {
        $_[0] =~ m/
                        ^  ([^:]+)    # username 
                        :  ([^\s\@]+) # password
                        \@ ([\w\-\.]+)  # hostname
                        :  (\d+) $    # port
                /x or die "Bad connection string: $_[0]";

        $args{username} = $1;
        $args{password} = $2;
        $args{host}     = $3;
        $args{port}     = $4;
    }
    else { %args = @_; }
    
    foreach my $key (@REQUIRED_FIELDS) {
        die "Invalid connection info. Missing $key." unless $args{$key};
    }

    my $self = bless ({}, ref ($class) || $class);

    $self->host($args{host});
    $self->port($args{port});
    $self->username($args{username});
    $self->password($args{password});

    return ($self);
}

sub query 
{
    my $self   = shift;
    my $xquery = shift;

    die "Need xquery argument" unless $xquery = uri_escape($xquery);


    my $request = HTTP::Request->new("POST", $self->server_uri, 
                                     $self->header, "xquery=$xquery");

    my $http_response = $self->ua->request($request);

    my $result = Net::MarkLogic::XDBC::Result->new( 
            response => $http_response 
            );

    return $result;
}

sub query_from_template 
{
    my $self     = shift;
    my $template = shift;
    my $args     = shift;
 
    my $t = Template->new();

    my $xquery;
    $t->process($template, $args, \$xquery);

    return $self->query($xquery);  
} 
# server_uri()
# The XDBC uri, either generated from defaults based on the given host and port
# or generated from a supplied uri.
sub server_uri 
{
    my $self = shift;

    if ($self->uri) { return $self->uri; }
    else { return "http://" . $self->host . ":" . $self->port . "/eval"; }
}

sub ua 
{
    my $self = shift;
                                                                                
    $self->{ua} = $_[0] if $_[0];

    unless ($self->{ua}) 
    {
        my $ua = LWP::UserAgent->new( agent => 
                     "Net::MarkLogic::XDBC/$VERSION MarkXDBC/2.2-1",);
        $self->{ua} = $ua;
    }                                                                                 
    return $self->{ua};
}

sub header 
{
    my $self = shift;
    
    $self->{header} = $_[0] if $_[0];

    unless ($self->{header}) 
    {
        my $header = HTTP::Headers->new();
        $header->authorization_basic( $self->username, $self->password );
        $self->{header} = $header;
    }
   
    return $self->{header};
}

1; #this line is important and will help the module return a true value
__END__