File Coverage

blib/lib/Net/DSLProvider/Murphx.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package Net::DSLProvider::Murphx;
use strict;
use warnings;
use HTML::Entities qw(encode_entities_numeric);
use base 'Net::DSLProvider';
use constant ENDPOINT => "https://xml.xps.murphx.com/";
use LWP::UserAgent;
use XML::Simple;
use Time::Piece;
my $ua = LWP::UserAgent->new;
__PACKAGE__->mk_accessors(qw/clientid/);

my %formats = (
    selftest => { sysinfo => { type => "text" }},
    availability => { cli => "phone", detailed => "yesno", ordertype =>
    "text", postcode => "postcode"},
    leadtime => { "product-id" => "counting", "order-type" => "text" },
    order_status => {"order-id" => "counting" },
    order_eventlog_history => { "order-id" => "counting" },
    order_eventlog_changes => { "date" => "datetime" },
    woosh_request_oneshot => {  "service-id" => "counting",
        "fault-type" => "text", "has-worked" => "yesno", "disruptive" => "yesno",
        "fault-time" => "datetime" },
    woosh_list => { "service-id" => "counting" },
    woosh_response => { "woosh-id" => "counting" },
    change_password => { "service-id" => "counting", "password" => "password" },
    service_actions => { "service-id" => "counting" },
    service_details => { "service-id" => "counting", "detailed" => "yesno" },
    service_status => { "service-id" => "counting", "order-id" => "counting" },
    service_view => { "service-id" => "counting" },
    service_usage_summary => { "service-id" => "counting",
        "year" => "counting", "month" => "text" },
    service_auth_log => { "service-id" => "counting", "rows" => "counting" },
    service_session_log => { "service-id" => "counting", "rows" => "counting" },
    service_eventlog_changes => { "start-date" => "datetime", "stop-date" => "datetime" },
    service_eventlog_history => { "service-id" => "counting" },
    service_terminate_session => { "service-id" => "counting" },
    services_overusage => { "period" => "text", "limit" => "counting" },
    speed_limit_enable => { "upstream-limit" => "counting",
        "downstream-limit" => "counting", "service-id" => "counting" },
    speed_limit_disable => { "service-id" => "counting" },
    speed_limit_status => { "service-id" => "counting" },
    service_suspend => { "service-id" => "counting", "reason" => "text" },
    service_unsuspend => { "service-id" => "counting" },
    walledgarden_status => { "service-id" => "counting" },
    walledgarden_enable => { "service-id" => "counting", "redirect-to" => "ip-address" },
    walledgarden_disable => { "service-id" => "counting" },
    change_carelevel => { "service-id" => "counting", "care-level" => "text" },
    requestmac => { "service-id" => "counting", "reason" => "text" },
    modify_options => { "service-id" => "counting" },
    cease => {
        order => {
            "service-id" => "counting", "reason" => "text",
            "client-ref" => "text", "crd" => "datetime", "accepts-charges" => "yesno"
        }
    },
    modify => {
        order => {
            "service-id" => "counting", "client-ref" => "text", "crd" => "date",
            "prod-id" => "counting", "cli" => "phone",
            attributes => { "care-level" => "text", "inclusive-transfer" => "counting",
                "test-mode" => "yesno" },
        }
    },
    provide => {
        order => {
            "client-ref" => "text", cli => "phone", "prod-id" => "counting",
            crd => "datetime", username => "text",
            attributes => {
                password => "password", realm => "text",
                "fixed-ip" => "yesno", "routed-ip" => "yesno",
                "allocation-size" => "counting", "care-level" => "text",
                "hardware-product" => "counting",
                "max-interleaving" => "text", "test-mode" => "yesno",
                "inclusive-transfer" => "counting", "pstn-order-id" => "text"
            }
        }, customer => {
            (map { $_ => "text" } qw/title forename surname company building
                street city county sub-premise/),
            postcode => "postcode", telephone => "phone",
            mobile => "phone", fax => "phone", email => "email"
        }
    },
    migrate => {
        order => {
            "client-ref" => "text", cli => "phone", "prod-id" => "counting",
            crd => "datetime", username => "text",
            attributes => {
                password => "password", realm => "text",
                "fixed-ip" => "yesno", "routed-ip" => "yesno",
                "allocation-size" => "counting", "care-level" => "text",
                "hardware-product" => "counting",
                "max-interleaving" => "text", "test-mode" => "yesno",
                "mac" => "text", "losing-isp" => "text",
                "inclusive-transfer" => "counting", "pstn-order-id" => "text"
            }
        }, customer => {
            (map { $_ => "text" } qw/title forename surname company building
                street city county sub-premise/),
            postcode => "postcode", telephone => "phone",
            mobile => "phone", fax => "phone", email => "email"
        }
    },
    case_new => {
        "service-id" => "counting", "service-type" => "text",
        "appsource" => "text", "cli" => "phone", "client-id" => "counting",
        "customer-id" => "counting", "experienced" => "datetime",
        "hardware-product" => "text", "os" => "text", "priority" => "text",
        "problem-type" => "text", "reported" => "text",
        "username" => "text",
    },
    case_view => { "case-id" => "counting" },
    case_update => { "case-id" => "counting", "reason" => "text",
        "priority" => "text"
    },
    case_history => { "case-id" => "counting" },
    case_search => { "case-id" => "counting", "service-id" => "counting",
        "customer-id" => "counting", "service-type" => "text",
        "username" => "text", "partial-cli" => "text", engineer => "text",
        "problem-type" => "text", "priority" => "text", status => "text",
        },
    customer_details => { "service-id" => "counting", "detailed" => "yesno" },
    product_details => { "product-id" => "counting", "detailed" => "yesno" },
);


sub _request_xml {
    my ($self, $method, $data) = @_;
    my $id = time.$$;
    my $xml = qq{


            @{[$self->clientid]}
            @{[$self->user]}
            @{[$self->pass]}

        };

    my $recurse;
    $recurse = sub {
        my ($format, $data) = @_;
        while (my ($key, $contents) = each %$format) {
            if (ref $contents eq "HASH") {
                if ($key) { $xml .= "\t\n"; }
                $recurse->($contents, $data->{$key});
                if ($key) { $xml .= "\t\n"; }
            } else {
                $xml .= qq{\t\t}.encode_entities_numeric($data->{$key})."\n"
                if $data->{$key};
            }
        }
    };
    $recurse->($formats{$method}, $data);
    $xml .= "\n";

    return $xml;
}

sub _make_request {
    my ($self, $method, $data) = @_;
    my $xml = $self->_request_xml($method, $data);
    my $request = HTTP::Request->new(POST => ENDPOINT);
    $request->content_type('text/xml');
    $request->content($xml);
    if ($self->debug) { warn "Sending request: \n".$request->as_string;}
    my $resp = $ua->request($request);
    die "Request for Murphx method $method failed: " . $resp->message if $resp->is_error;
    if ($self->debug) { warn "Got response: \n".$resp->content;}
    my $resp_o = XMLin($resp->content);
    if ($resp_o->{status}{no} > 0) { die  $resp_o->{status}{text} };

    my $recurse = undef;
    $recurse = sub {
        my $input = shift;
        while ( my ($oldkey, $contents) = each %$input ) {
            my $newkey = $oldkey;
            $newkey =~ s/-/_/g;
            $recurse->($contents) if ref $contents eq 'HASH';
            if ( ref $contents eq "ARRAY" ) {
                for my $r ( @{$contents} ) {
                    $recurse->($r);
                }
            }
            $input->{$newkey} = $contents;
            delete $input->{$oldkey} if $oldkey =~ /-/;
        }
    };
    $recurse->($resp_o);

    return $resp_o;
}

=head2 services_available

    $murphx->services_available( cli => "02071112222" );

Returns an hash showing the available services and line qualifications
as follows:

  ( qualification => {
        classic => '2048000',
        max => '4096000',
        2plus => '5120000',
        fttc => {
            'up' => '6348800',
            'down' => '27750400'
        },
        'first_date' => '2011-03-01'
    },
    product_id => {
        'first_date' => '2011-03-01',
        'max_speed' => '4096000',
        'product_name' => 'DSL Product Name'
    },
    ...
  )

=cut

sub services_available {
    my ($self, %args) = @_;
    $self->_check_params(\%args);

    %args = ( %args, detailed => "Y", ordertype => "migrate" );

    my $response = $self->_make_request("availability", \%args);

    my %crd = ();
    while ( my $a = pop @{$response->{block}->{leadtimes}->{block}} ) {
        my $pid = $a->{a}->{'product_id'}->{content};
        $crd{$pid} = $a->{a}->{'first_date_text'}->{content};
    }

    my %rv = ();

    my $a = $response->{block}->{availability}->{block};
    foreach (qw/classic max 2plus fttc/) {
        my $q = $a->{$_.'_qualification'};
        if ( $_ ne 'fttc' ) {
            $rv{qualification}->{$_} = $q->{a}->{'likely_max_speed'}->{content};
            if ( $_ eq '2plus' && $q->{block}->{'name'} eq 'annex-m' ) {
                $rv{qualification}->{$_.'_m_up'} = $q->{block}->{a}->{'likely_max_speed_up'}->{content};
                $rv{qualification}->{$_.'_m_down'} = $q->{block}->{a}->{'likely_max_speed_down'}->{content};
            }
            $rv{qualification}->{top} = $rv{qualification}->{$_};
        }
        else {
            $rv{qualification}->{$_}->{'down'} = $q->{a}->{'likely_max_speed_down'}->{content};
            $rv{qualification}->{$_}->{'up'} = $q->{a}->{'likely_max_speed_up'}->{content};
        }
    }
    return if ! $rv{qualification}->{classic} > 0; # There is no data to report!

    $rv{qualification}->{first_date} = $crd{1317}; # ADSL MAX Classic first available CRD

    # Now return the list of actual services available
    while ( my $a = pop @{$response->{block}->{products}->{block}} ) {
        $rv{$a->{a}->{'product_id'}->{content}} = {
              first_date   => $crd{$a->{a}->{'product_id'}->{content}},
              product_name => $a->{a}->{'product_name'}->{content},
              max_speed => $a->{a}->{'service_speed'}->{content},
            };
    }
    return %rv;
}

=head2 modify

    $murphx->modify(
        "service-id" => "12345", "client-ref" => "myref", "prod-id" => "1000",
        "crd" => "2009-12-31", "care-level" => "standard" "inclusive-transfer" => "3",
        "test-mode" = "N" );

Modify the service specificed in service-id. Parameters are as per the Murphx documentation

Returns order-id for the modify order.

=cut

sub modify {
    my ($self, %args) = @_;
    $self->_check_params(\%args, qw/service-id client-ref myref prod-id
                        crd care-level inclusive-transfer test-mode / );

    my $response = $self->_make_request("modify", \%args);

    return $response->{a}->{"order_id"}->{content};
}

=head2 change_password

    $murphx->change_password( "service-id" => "12345", "password" => "secret" );

Changes the password for the ADSL login on the given service.

Requires service-id and password

Returns 1 for successful password change.

=cut

sub change_password {
    my ($self, %args) = @_;
    $self->_check_params(\%args, qw/service-id password/);

    my $response = $self->_make_request("change_password", \%args);

    return 1;
}

=head2 woosh_response

    $murphx->woosh_response( "12345" );

Obtains the results of a Woosh test, previously requested using
request_woosh(). Takes the ID of the woosh test as its only parameter.
Note that this will only return results for completed Woosh tests. Use
woosh_list() to determine if the woosh test is completed.

Returns an hash containing a hash for each set of test results. See
Murphx documentation for details of the test result fields.

=cut

sub woosh_response {
    my ($self, $id) = @_;
    die "You must provide the woosh-id parameter" unless $id;
    my $response = $self->_make_request("woosh_response", { "woosh-id" => $id });

    my %results = ();
    foreach ( keys %{$response->{block}->{block}} ) {
        my $b = $_;
        foreach ( keys %{$response->{block}->{block}->{$b}->{a}} ) {
            $results{$b}{$_} = $response->{block}->{block}->{$b}->{a}->{$_}->{content};
        }
    }
    return \%results;
}

=head2 woosh_list

    $murphx->woosh_list( "12345" );

Obtain a list of all woosh tests requested for the given service-id and
their status.

Requires service-id as the single parameter.

Returns an array, each element of which is a hash containing the
following fields for each requested Woosh test:

    service-id woosh-id start-time stop-time status

The array elements are sorted by date with the most recent being first.

=cut

sub woosh_list {
    my ($self, $id) = @_;
    die "You must provide the woosh-id parameter" unless $id;
    my $response = $self->_make_request("woosh_list", { "woosh-id" => $id });

    my @list = ();
    if ( ref $response->{block}->{block} eq "ARRAY" ) {
        while ( my $b = shift @{$response->{block}->{block}} ) {
            my %a = ();
            foreach ( keys %{$b->{a}} ) {
                $a{$_} = $b->{a}->{$_}->{content};
            }
            push @list, \%a;
        }
    } else {
        my %a = ();
        foreach ( keys %{$response->{block}->{block}->{a}} ) {
            $a{$_} = $response->{block}->{block}->{a}->{$_}->{content};
        }
        push @list, \%a;
    }

    return @list;
}

=head2 request_woosh

    $murphx->request_woosh( "service-id" => "12345", "fault-type" => "EPP",
        "has-worked" => "Y", "disruptive" => "Y", "fault-time" => "2007-01-04 15:33:00");

Alias to woosh_request_oneshot

=cut

sub request_woosh { goto &woosh_request_oneshot; }

=head2 woosh_request_oneshot

    $murphx->woosh_request_oneshot( "service-id" => "12345", "fault-type" => "EPP",
        "has-worked" => "Y", "disruptive" => "Y", "fault-time" => "2007-01-04 15:33:00");

Places a request for  Woosh test to be run on the given service.
Parameters are passed as a hash which must contain:

    service-id - ID of the service
    fault-type - Type of fault to check. See Murphx documentation for available types
    has-worked - Y if the service has worked in the past, N if it has not
    disruptive - Y to allow Woosh to run a test which will be disruptive to the service.
    fault-time - date and time (ISO format) the fault occured

Returns a scalar which is the id of the woosh test. Use woosh_response
with this id to get the results of the Woosh test.

=cut

sub woosh_request_oneshot {
    my ($self, %args) = @_;
    $self->_check_params(\%args, qw/service-id fault-type has-worked
                            disruptive fault-time /);

    my $response = $self->_make_request("woosh_request_oneshot", \%args);

    return $response->{a}->{"woosh_id"}->{content};
}

=head2 order_updates_since

    $murphx->order_updates_since( "date" => "2007-02-01 16:10:05" );

Alias to order_eventlog_changes

=cut

sub order_updates_since { goto &order_eventlog_changes; }

=head2 order_eventlog_changes

    $murphx->order_eventlog_changes( "date" => "2007-02-01 16:10:05" );

Returns a list of events that have occurred on all orders since the provided date/time.

The return is an date/time sorted array of hashes each of which contains the following fields:
    order-id date name value

=cut

sub order_eventlog_changes {
    my ($self, %args) = @_;
    $self->_check_params(\%args, qw/date/);

    my $response = $self->_make_request("order_eventlog_changes", \%args);

    my @updates = ();

    if ( ref $response->{block}->{block} eq "ARRAY" ) {
        while (my $b = shift @{$response->{block}->{block}} ) {
            my %a = ();
            foreach ( keys %{$b->{a}} ) {
                $a{$_} = $b->{a}->{$_}->{content};
                if ( $_ eq 'date' && $args{dateformat} ) {
                    my $d = Time::Piece->strptime($a{$_}, "%Y-%m-%d %H:%M:%S");
                    $a{$_} = $d->strftime($args{dateformat});
                }
            }
            push @updates, \%a;
        }
    } else {
        my %a = ();
        foreach (keys %{$response->{block}->{block}->{a}} ) {
            $a{$_} = $response->{block}->{block}->{a}->{$_}->{content};
            if ( $_ eq 'date' && $args{dateformat} ) {
                my $d = Time::Piece->strptime($a{$_}, "%Y-%m-%d %H:%M:%S");
                $a{$_} = $d->strftime($args{dateformat});
            }
        }
        push @updates, \%a;
    }
    return @updates;
}

=head2 auth_log

    $murphx->auth_log( "service-id" => '12345', "rows" => "5" );

Alias for service_auth_log

=cut

sub auth_log { goto &service_auth_log; }

=head2 service_auth_log

    $murphx->service_auth_log( "service-id" => '12345', "rows" => "5" );

Gets the last n rows, as specified in the rows parameter, of authentication log entries for the service

Returns an array, each element of which is a hash containing:
    auth-date, username, result and, if the login failed, error-message

=cut

sub service_auth_log {
    my ($self, %args) = @_;
    $self->_check_params(\%args, qw/service-id rows/);

    my $response = $self->_make_request("service_auth_log", \%args);

    my @auth = ();
    if ( ref $response->{block} eq "ARRAY" ) {
        while ( my $r = shift @{$response->{block}} ) {
            my %a = ();
            foreach ( keys %{$r->{block}->{a}} ) {
                $a{$_} = $r->{block}->{a}->{$_}->{content};
                if ( $_ eq 'auth_date' && $args{dateformat} ) {
                    my $d = Time::Piece->strptime($r->{block}->{a}->{$_}->{content}, "%Y-%m-%d %H:%M:%S");
                    $a{$_} = $d->strftime($args{dateformat});
                }
            }
            push @auth, \%a;
        }
    } else {
        my %a = ();
        foreach (keys %{$response->{block}->{block}->{a}} ) {
            $a{$_} = $response->{block}->{block}->{a}->{$_}->{content};
            if ( $_ eq 'auth_date' && $args{dateformat} ) {
                my $d = Time::Piece->strptime($response->{block}->{block}->{a}->{$_}->{content}, "%Y-%m-%d %H:%M:%S");
                $a{$_} = $d->strftime($args{dateformat});
            }
        }
        push @auth, \%a;
    }

    return @auth;
}

=head2 session_log

    $murphx->session_log( { } );

Alias for service_session_log

=cut

sub session_log { goto &service_session_log; }

=head2 service_session_log

    $murphx->service_session_log( "session-id" => "12345", "rows" => "5" );

Gets the last entries in the session log for the service. The number of
entries is specified in the "rows" parameter.

Returns an array each element of which is a hash containing:

    start-time stop-time download upload termination-reason

=cut

sub service_session_log {
    my ($self, %args) = @_;
    for (qw/service-id rows/) {
        if (!$args{$_}) { die "You must provide the $_ parameter"; }
    }

    my $response = $self->_make_request("service_session_log", \%args);

    my @sessions = ();
    if ( ref $response->{block} eq "ARRAY" ) {
        while ( my $r = shift @{$response->{block}} ) {
            my %a = ();

            foreach ( keys %{$r->{block}->{a}} ) {
                $a{$_} = $r->{block}->{a}->{$_}->{content};
                if ( $args{dateformat} && ($_ eq 'start_time' || $_ eq "stop_time") ) {
                    my $d = Time::Piece->strptime($a{$_}, "%Y-%m-%d %H:%M:%S");
                    $a{$_} = $d->strftime($args{dateformat});
                }
            }


            $a{"download"} = delete $a{"output-octets"};
            $a{"upload"} = delete $a{"input-octets"};
            push @sessions, \%a;
        }
    } else {
        my %a = ();
        foreach (keys %{$response->{block}->{block}->{a}} ) {
            $a{$_} = $response->{block}->{block}->{a}->{$_}->{content};
            if ( $args{dateformat} && ($_ eq 'start_time' || $_ eq "stop_time") ) {
                my $d = Time::Piece->strptime($a{$_}, "%Y-%m-%d %H:%M:%S");
                $a{$_} = $d->strftime($args{dateformat});
            }
        }

        $a{"download"} = delete $a{"output_octets"};
        $a{"upload"} = delete $a{"input_octets"};
        push @sessions, \%a;
    }
    return @sessions;
}

=head2 usage_summary

    $murphx->usage_summary( "service-id" =>'12345', "year" => '2009', "month" => '01' );

Alias for service_usage_summary()

=cut

sub usage_summary { goto &service_usage_summary; }

=head2 service_usage_summary

    $murphx->service_usage_summary( "service-id" =>'12345', "year" => '2009', "month" => '01' );

Gets a summary of usage in the given month. Inputs are service-id, year, month.

Returns a hash with the following fields:

    year, month, username, total-sessions, total-session-time,
    total-input-octets, total-output-octets

Input octets are upload bandwidth. Output octets are download bandwidth.

Be warned that the total-input-octets and total-output-octets fields
returned appear to be MB rather than octets contrary to the Murphx
documentation.

=cut

sub service_usage_summary {
    my ($self, %args) = @_;
    for (qw/ service-id year month /) {
        if ( ! $args{$_} ) { die "You must provide the $_ parameter"; }
    }

    my $response = $self->_make_request("service_usage_summary", \%args);

    my %usage = ();
    foreach ( keys %{$response->{block}->{a}} ) {
        $usage{$_} = $response->{block}->{a}->{$_}->{content};
    }
    return %usage;
}

=head2 service_terminate_session

    $murphx->service_terminate_session( "12345" );

Terminates the current session on the given service-id.

Returns 1 if successful

=cut

sub service_terminate_session {
    my ($self, $id) = @_;
    die "You must provide the service-id parameter" unless $id;

    my $response = $self->_make_request("service_terminate_session",
        {"service-id" => $id});

    return 1;
}

=head2 cease

    $murphx->cease( "service-id" => 12345, "reason" => "This service is no longer required"
        "client-ref" => "ABX129", "crd" => "1970-01-01", "accepts-charges" => 'Y' );

Places a cease order to terminate the ADSL service completely. Takes input as a hash.

Required parameters are : service-id, crd, client-ref

Returns order-id which is the ID of the cease order for tracking purposes.

=cut

sub cease {
    my ($self, %args) = @_;
    for (qw/service-id crd client-ref reason/) {
        if (!$args{$_}) { die "You must provide the $_ parameter"; }
    }

    # The cease method parameters have to be passed inside $data->{order}
    my $data = { };
    foreach (keys %args) {
        $data->{order}{$_} = $args{$_};
    }

    my $response = $self->_make_request("cease", $data);
    return $response->{"order_id"}->{content};
}

=head2 request_mac

    $murphx->requestmac( "service-id" => '12345', "reason" => "EU wishes to change ISP" );

Obtains a MAC for the given service. Parameters are service-id and
reason the customer wants a MAC.

Returns a hash comprising: mac, expiry-date

=cut

sub request_mac {
    my ($self, %args) = @_;
    for (qw/service-id reason/) {
        if ( ! $args{$_} ) { die "You must provide the $_ parameter"; }
        }

    my $response = $self->_make_request("requestmac", \%args);

    return (
        mac => $response->{a}->{"mac"}->{content},
        "expiry_date" => $response->{a}->{"expiry_date"}->{content}
    );
}

=head2 service_status

    $murphx->service_status( "12345" );

Gets the current status for the given service id.

Returns a hash containing:

    live, username, ip-address, session-established, session-start-date,
    ping-test, average-latency

=cut

sub service_status {
    my ($self, $id) = @_;
    die "You must provide the service-id parameter" unless $id;
    my $response = $self->_make_request("service_status",
        { "service-id" => $id });

    my %status = ();
    foreach ( keys %{$response->{block}->{a}} ) {
        $status{$_} = $response->{block}->{a}->{$_}->{content};
    }
    return %status
}

=head2 service_history

   $murphx->service_history( "12345" );

Returns the full history for the given service as an array each element
of which is a hash:

    order-id name date value

=cut

sub service_history { goto &service_eventlog_history; }

=head2 service_eventlog_history

$murphx->service_eventlog_history( "12345" );

Returns the full history for the given service as an array each element
of which is a hash:

    order-id name date value

=cut

sub service_eventlog_history {
    my ($self, $id) = @_;
    die "You must provide the service-id parameter" unless $id;
    my @history = ();

    my $response = $self->_make_request("service_eventlog_history",
        {"service-id" => $id });

    if ( ref $response->{block}->{block} eq "ARRAY" ) {
        while ( my $a = pop @{$response->{block}->{block}} ) {
            my %a = ();
            foreach (keys %{$a->{a}}) {
                $a{$_} = $a->{'a'}->{$_}->{'content'};
            }
            push @history, \%a;
        }
    } else {
        my %a = ();
        foreach (keys %{$response->{block}->{block}->{a}} ) {
            $a{$_} = $response->{block}->{block}->{a}->{$_}->{'content'};
        }
        push @history, \%a;
    }
    return @history;
}

=head2 services_history

    $murphx->services_history( "start-date" => "2007-01-01", "stop-date" => "2007-02-01" );

Returns an array each element of which is a hash continaing the following data:

    service-id order-id date name value

=cut

sub services_history { goto &service_eventlog_changes; }

=head2 service_eventlog_changes

    $murphx->service_eventlog_changes( "start-date" => "2007-01-01", "stop-date" => "2007-02-01" );

Returns an array each element of which is a hash continaing the following data:

    service-id order-id date name value

=cut

sub service_eventlog_changes {
    my ($self, %args) = @_;
    for ( qw/ start-date stop-date /) {
        if (!$args{$_}) { die "You must provide the $_ parameter"; }
    }

    my $response = $self->_make_request("service_eventlog_changes", \%args);

    my @changes = ();
    if ( ref $response->{block}->{block} eq 'ARRAY' ) {
        while ( my $a = shift @{$response->{block}->{block}} ) {
            my %u = ();
            foreach (keys %{$a->{a}}) {
                $u{$_} = $a->{'a'}->{$_}->{content};
            }
            push(@changes, \%u);
        }
    } else {
        my %u = ();
        foreach ( keys %{$response->{block}->{block}->{a}} ) {
            $u{$_} = $response->{block}->{block}->{'a'}->{$_}->{content};
        }
        push(@changes, \%u);
    }
    return @changes;
}


=head2 order_status

    $murphx->order_status( '12345' );

Gets status of an order. Input is the order-id from Murphx

Returns a hash containing a hash order and a hash customer
The order hash contains:

    order-id, service-id, client-ref, order-type, cli, service-type, service,
    username, status, start, finish, last-update

The customer hash contains:

    forename, surname, address, city, county, postcode, telephone, building

=cut

sub order_status {
    my ($self, $id) = @_;
    die "You must provide the order-id parameter" unless $id;

    my $response = $self->_make_request("order_status", { "order-id" => $id });

    my %order = ();
    foreach (keys %{$response->{block}->{order}->{a}} ) {
        $order{order}{$_} = $response->{block}->{order}->{a}->{$_}->{content};
        }
    foreach (keys %{$response->{block}->{customer}->{a}} ) {
        $order{customer}{$_} = $response->{block}->{customer}->{a}->{$_}->{content};
        }
    return %order;
}

=head2 service_view

    $murphx->service_view ( "service-id" => '12345' );

Combines the data from service_details, service_history and service_options

Returns a hash as follows:

    %service = (    "service-details" => {
                        service-id => "", product-id => "",
                        ... },
                    "service-options" => {
                        "speed-limit" => "", "suspended" => "",
                        ... },
                    ""service-history" => {
                        [
                            { "event-date" => "", ... },
                            ...
                        ] },
                    "customer-details" => {
                        "title" => "", "forename", ... }
                )

See Murphx documentation for full details

=cut

sub service_view {
    my ($self, %args) = @_;
    die "You must provide the service-id parameter" unless $args{"service-id"};

    my $response = $self->_make_request("service_view", \%args);

    my %actions = $self->service_actions(%args);

    my %service = ();
    foreach ( keys %{$response->{block}} ) {
        my $b = $_;
        if ( $response->{block}->{$b}->{block} ) {
            my @history = ();
            while ( my $h = pop @{$response->{block}->{$b}->{block}} ) {
                my %a = ();
                foreach ( keys %{$h->{a}} ) {
                    next if ( $_ =~ /(event_id|operator|operator_id)/ );
                    $a{$_} = $h->{a}->{$_}->{content};
                }
                push @history, \%a;
            }
            $service{$b} = \@history;
        }
        else {
            foreach ( keys %{$response->{block}->{$b}->{a}} ) {
                $service{$b}{$_} = $response->{block}->{$b}->{a}->{$_}->{content};
            }
        }
    }
    $service{"service_actions"} = \%actions;
    return %service;
}

=head2 service_details

    $murphx->service_details( '12345' );

Obtains details of the service identified by "service-id" from Murphx

Returns a hash with details including (but not limited to):
    activation-date, cli, care-level, technology-type, service-id
    username, password, live, product-name, ip-address, product-id
    cidr

=cut

sub service_details {
    my ($self, %args) = @_;
    $self->_check_params(\%args, qw/service-id/);

    my $data = { detailed => 'Y', "service-id" => $args{"service-id"} };

    my $response = $self->_make_request("service_details", $data);

    my %details = ();
    foreach (keys %{$response->{block}->{a}} ) {
        $details{$_} = $response->{block}->{a}->{$_}->{content};
        }
    return %details;
}

=head2 interleaving_status

    $murphx->interleaving_status( "service-id" => 12345 );

Returns current interleaving status if available or undef;

If not undef status can be one of:

    'opt-in', 'opt-out' or 'auto'

=cut

sub interleaving_status {
    my ($self, %args) = @_;
    $self->_check_params(\%args, qw/service-id/);

    my %d = $self->service_details( %args );
    return $d{"max_interleaving"};
}

=head2 order_history

    $murphx->order_history( 12345 );

Alias to C

=cut


sub order_history { goto &order_eventlog_history; }

=head2 order_eventlog_history

    $murphx->order_eventlog_history( 12345 );

Gets order history

Returns an array, each element of which is a hash showing the next
update in date sorted order. The hash keys are date, name and value.

=cut

sub order_eventlog_history {
    my ($self, $order) = @_;
    return undef unless $order;
    my $response = $self->_make_request("order_eventlog_history", { "order-id" => $order });

    my @history = ();

    while ( my $a = shift @{$response->{block}{block}} ) {
        foreach (keys %{$a}) {
            my %u = ();
            $u{date} = $a->{'a'}->{'date'}->{'content'};
            $u{name} = $a->{'a'}->{'name'}->{'content'};
            $u{value} = $a->{'a'}->{'value'}->{'content'};

            push(@history, \%u);
        }
    }
    return @history;
}

=head2 services_overusage

    $murphx->services_overusage( "period" => "", "limit" => "100" );

Returns an array each element of which is a hash detailing each service which has
exceeded its usage cap. See the Murphx documentation for details.

=cut

sub services_overusage {
    my ($self, %args) = @_;
    die "You must provide the period parameter" unless $args{"period"};

    my $response = $self->_make_request("services_overusage", \%args);

    my @services = ();
    if ( ref $response->{block} eq "ARRAY" ) {
        while ( my $b = shift @{$response->{block}} ) {
        my %a = ();
            foreach (keys %{$b->{block}->{a}}) {
                $a{$_} = $b->{block}->{a}->{$_}->{content};
            }
            push @services, \%a;
        }
    } else {
        my %a = ();
        foreach ( keys %{$response->{block}->{block}->{a}} ) {
            $a{$_} = $response->{block}->{block}->{a}->{$_}->{content};
        }
        push @services, \%a;
    }
    return @services;
}

=head2 speed_limit_status

    $murphx->speed_limit_status( 12345 );

Returns either a hash reference or a description of the speed limit
status.

=cut

sub speed_limit_status {
    my ($self, $id) = @_;
    die "You must provide the service-id parameter" unless $id;

    my $response = $self->_make_request("speed_limit_status",
        {"service-id" => $id});

    if ( $response->{a}->{content} ) { return $response->{a}->{content}; }
    else {
        my %status = ();
        foreach (keys %{$response->{a}} ) {
            $status{$_} = $response->{a}->{$_}->{content};
        }
        return \%status;
    }
}

=head2 speed_limit_enable

    $murphx->speed_limit_enable( "service-id" => 12345,
        "upstream-limit" => "768",
        "downstream-limit" => "768",
    );

Set speed limits for the given service.

=cut

sub speed_limit_enable {
    my ($self, %args) = @_;
    for ( qw/service-id upstream-limit downstream-limit/ ) {
        die "You must provide the $_ parameter" unless $args{$_};
    }

    my $response = $self->_make_request("speed_limit_enable", \%args);
    return 1;
}

=head2 speed_limit_disable

    $murphx->speed_limit_disable( 12345 );

Turn off speed limits for the given service.

=cut

sub speed_limit_disable {
    my ($self, %args) = @_;
    die "You must provide the service-id parameter" unless $args{"service-id"};

    my $response = $self->_make_request("speed_limit_disable", \%args);
    return 1;
}

=head2 service_unsuspend

    $murphx->service_unsuspend( 12345 );

Unsuspend this broadband service.

=cut

sub service_unsuspend {
    my ($self, %args) = @_;
    die "You must provide the service-id parameter" unless $args{"service-id"};

    my $response = $self->_make_request("service_unsuspend", \%args);
    return 1;
}

=head2 service_suspend

    $murphx->service_suspend( "service-id" => 12345,
                              reason => "I don't like them");

Suspend this broadband service for the given reason.

=cut

sub service_suspend {
    my ($self, %args) = @_;
    for ( qw/service-id reason/) {
        die "You must provide the $_ parameter" unless $args{$_};
    }

    my $response = $self->_make_request("service_suspend", \%args);
    return 1;
}

=head2 walledgarden_status

    $murphx->walledgarden_status( "service-id" => 12345 );

Returns true is the current service is subject to walled garden
restrictions or undef if not.

=cut

sub walledgarden_status {
    my ($self, %args) = @_;
    die "You must provide the service-id parameter" unless $args{"service-id"};

    my $response = $self->_make_request("walledgarden_status", \%args);

    return 1 if $response->{a}->{walledgarden}->{content} eq 'enabled';
    return undef;
}

=head2 walledgarden_enable

    $murphx->walledgarden_enable( "service-id" => 12345, "ip-address" -> '192.168.1.1' );

Redirects all (http and https) traffic to the specified IP address

=cut

sub walledgarden_enable {
    my ($self, %args) = @_;
    for ( qw/service-id ip-address/) {
        die "You must provide the $_ parameter" unless $args{$_};
    }

    my $response = $self->_make_request("walledgarden_enable", \%args);
    return 1;
}

=head2 walledgarden_disable

    $murphx->walledgarden_disable( "service-id" => 12345 );

Disables the "walled garden" restriction on the service

=cut

sub walledgarden_disable {
    my ($self, %args) = @_;
    die "You must provide the service-id parameter" unless $args{"service-id"};

    my $response = $self->_make_request("walledgarden_disable", \%args);
    return 1;
}

=head2 change_carelevel

    $murphx->change_carelevel( "service-id" -> 12345, "care-level" => "enhanced" );

Changes the care-level associated with a given service.

care-level can be set to either standard or enhanced.

Returns true is successful.

=cut

sub change_carelevel {
    my ($self, %args) = @_;
    $self->_check_params( \%args );

    my $response = $self->_make_request("change_carelevel", \%args);
    return 1;
}

=head2 care_level

    $murphx->carei_level( "service-id" -> 12345, "care-level" => "enhanced" );

Changes the care-level associated with a given service.

care-level can be set to either standard or enhanced.

Returns true is successful.

=cut


sub care_level {
    my ($self, %args) = @_;
    $self->_check_params( \%args );

    $self->change_carelevel( %args );
}

=head2 service_actions

    $murphx->service_actions( "service-id" -> 12345 );

Returns a hash detailing which actions can be taken on the given service.

Each action has a corresponding function in this module.

=cut

sub service_actions {
    my ($self, %args) = @_;

    die "You must provide the service-id parameter" unless $args{"service-id"};

    my $response = $self->_make_request("service_actions", \%args);

    my %ret = ();
    foreach ( keys %{$response->{block}->{a}} ) {
        $ret{$_} = $response->{block}->{a}->{$_}->{content};
    }
    return %ret;
}

=head2 product_details

    $murphx->product_details( $product-id );

Returns full product details for the given product id

=cut

sub product_details {
    my ($self, $id) = @_;
    die "You cannot must provide the product-id" unless $id;

    my $response = $self->_make_request("product_details",
        { "product-id" => $id, "detailed" => 'Y' });

    my %a = ();
    foreach ( keys %{$response->{block}->{a}} ) {
        $a{$_} = $response->{block}->{a}->{$_}->{content};
    }
    return %a
}

=head2 customer_details

    $murphx->customer_details($serviceId);

Returns the customer details for a given service ID

=cut

sub customer_details {
    my ($self, $id) = @_;

    die "You cannot call _get_customer_id without the service-id" unless $id;

    my $response = $self->_make_request("customer_details",
        { "service-id"=> $id, "detailed" => 'Y' });

    my %a = ();
    foreach (keys %{$response->{block}->{a}}) {
        $a{$_} = $response->{block}->{a}->{$_}->{content};
    }
    return %a;
}

=head2 case_new

    $murphx->case_new( "service-id" => 12345, "service-type" => "adsl",
        "username" => "username@realm", "cli" => "02071112222",
        "os" => "Linux", "hardware-product" => "Other",
        "problem-type" => "Connection", "experienced" => "2010-01-01",
        "reported" => "User does not have sync", "priority" => "High"  );

=cut

sub case_new {
    my ($self, %args) = @_;
    $self->_check_params(\%args, qw/service-id problem-type
        experienced reported priority/);

    $args{"client-id"} = $self->clientid;
    $args{"appsource"} = "XPS";
    $args{"service-type"} = "adsl";

    my %service = $self->service_details( %args );

    $args{username} = $service{username};
    $args{cli} = $service{cli};

    my $response = $self->_make_request("case_new", \%args);

# This is not finished. I need to determine the correct part of $response to return

    return $response;
}

=head2 case_view

    $murphx->case_view( "case-id" => "12345" );

Returns a hash containing details of an existing case

=cut

sub case_view {
    my ($self, %args) = @_;
    $self->_check_params(\%args, qw/case-id/);

    my $response = $self->_make_request("case_view", \%args);

    my %case = ();
    foreach (keys %{$response->{block}->{a}}) {
        $case{$_} = $response->{block}->{a}->{$_}->{content};
    }
    return %case;
}

=head2 case_search

    $murphx->case_search( "service-id" => 12345 );

Returns basic details of all cases matching a given search.

Search parameters can include the following (and must include at least
one of them):

    case-id, service-id, customer-id, service-type, username, partial-cli,
    engineer, problem-type, priority or status

Returns an array, each element of which is a hash providing basic
details of the case. Use case_view and case_history to get more details.

=cut

sub case_search {
    my ($self, %args) = @_;
    my $args = join('|', keys %{$formats{case_search}});
    $self->_check_params(\%args, ($args));

    my $response = $self->_make_request("case_search", \%args);

    my @cases = ();

    if ( ref $response->{block}->{block} eq "ARRAY" ) {
        while ( my $b = shift @{$response->{block}->{block}} ) {
            my %a = ();
            foreach (keys %{$b->{a}} ) {
                $a{$_} = $b->{a}->{$_}->{content};
            }
            push @cases, \%a;
        }
    }
    else {
        my %a = ();
        foreach (keys %{$response->{block}->{block}->{a}} ) {
            $a{$_} = $response->{block}->{block}->{a}->{$_}->{content};
        }
        push @cases, \%a;
    }

    return @cases;
}

=head2 case_history

    $murphx->case_history( "case-id" => "12345" );

Returns a full history for the given case-id.

Return is an array, each element of which is a hash detailing a
specific update to the case.

=cut

sub case_history {
    my ( $self, %args ) = @_;
    $self->_check_params( \%args, qw/case-id/ );

    my $response = $self->_make_request( "case_history", \%args );

    my @cases = ();

    if ( ref $response->{block}->{block} eq "ARRAY" ) {
        while ( my $b = shift @{$response->{block}->{block}} ) {
            my %a = ();
            foreach (keys %{$b->{a}} ) {
                $a{$_} = $b->{a}->{$_}->{content};
            }
            push @cases, \%a;
        }
    }
    else {
        my %a = ();
        foreach (keys %{$response->{block}->{block}->{a}} ) {
            $a{$_} = $response->{block}->{block}->{a}->{$_}->{content};
        }
        push @cases, \%a;
    }

    return @cases;
}

=head2 case_update

    $murphx->case_update( "case-id" => "12345", "priority" => "High",
        "reason" => "More information about problem" );

Updates the given case with update given in "reason".

Returns 1 if update completed.

=cut

sub case_update {
    my ( $self, %args ) = @_;
    $self->_check_params(\%args, qw/case-id priority reason/);

    my $response = $self->_make_request("case_update", \%args);

    return 1;
}

=head2 regrade_options

    $murphx->regrade_options( "service-id" => "12345" );

Returns an array containing details of the regrade options avaiulable on the
given service using the module. Each element of the array is a hash with
the same specification as returned by services_available

=cut

sub regrade_options {
    my ($self, %args) = @_;

    my $response = $self->_make_request("modify_options", \%args);

    my %crd = ();
    my @options = ();
    while ( my $l = shift @{$response->{block}->{leadtimes}->{block}} ) {
        $crd{$l->{a}->{"product-id"}->{content}} = $l->{a}->{"first-date-text"}->{content};
    }

    while ( my $p = shift @{$response->{block}->{products}->{block}} ) {
        push @options, {
            product_id => $p->{a}->{"product_id"}->{content},
            "product_name" => $p->{a}->{"product_name"}->{content},
            "first_date" => $crd{$p->{a}->{"product_id"}->{content}},
            "max_speed" => $p->{a}->{"service_speed"}->{content}
        };
    }
    return @options;
}

=head2 regrade

    $murphx->regrade( "service-id" => "12345",
                      "prod-id" => 1595,
                      "crd" => "2010-02-01" );

Places an order to regrade the specified service to the defined prod-id
on the crd specified. Use regrade_options first to determine which
products are available and the earliest crd available.

The parameters you may pass to this function are the same as for the
modify function. See Murphx documentation for details.

=cut

sub regrade {
    my ($self, %args) = @_;
    $args{'client-ref'} = $args{'service-id'}."-regrade" unless $args{'client-ref'};
    $args{'care-level'} = "standard" unless $args{'care-level'};

    return $self->modify(%args);
}

=head2 order

    $murphx->order(
        # Customer details
        forename => "Clara", surname => "Trucker",
        building => "123", street => "Pigeon Street", city => "Manchester",
        county => "Greater Manchester", postcode => "M1 2JX",
        telephone => "01614960213",
        # Order details
        clid => "01614960213", "client-ref" => "claradsl",
        "prod-id" => $product, crd => $leadtime, username => "claraandhugo",
        password => "skyr153", "care-level" => "standard",
        realm => "surfdsl.net"
    );

Submits an order for DSL to be provided to the specified phone line.
Note that all the parameters above must be supplied. CRD is the
requested delivery date in YYYY-mm-dd format; you are responsible for
computing dates after the minimum lead time. The product ID should have
been supplied to you by Murphx.

Additional parameters are listed below and described in the integration
guide:

    title street company mobile email fax sub-premise fixed-ip routed-ip
    allocation-size hardware-product max-interleaving test-mode
    inclusive-transfer

If a C and C is passed, then the order is understood as a
migration rather than a provision.

Returns a hash describing the order.

=cut

sub order {
    my ($self, %data_in) = @_;
    # We expect it "flat" and arrange it into the right blocks as we check it
    my $data = {};
    for (qw/forename surname building city county postcode telephone/) {
        if (!$data_in{$_}) { die "You must provide the $_ parameter"; }
        $data->{customer}{$_} = $data_in{$_};
    }
    defined $data_in{$_} and $data->{customer}{$_} = $data_in{$_}
        for qw/title street company mobile email fax sub-premise/;

    for (qw/cli client-ref prod-id crd username/) {
        if (!$data_in{$_}) { die "You must provide the $_ parameter"; }
        $data->{order}{$_} = $data_in{$_};
    }

    for (qw/password realm care-level/) {
        if (!$data_in{$_}) { die "You must provide the $_ parameter"; }
        $data->{order}{attributes}{$_} = $data_in{$_};
    }
    defined $data_in{$_} and $data->{order}{attributes}{$_} = $data_in{$_}
        for qw/fixed-ip routed-ip allocation-size hardware-product pstn-order-id
            max-interleaving test-mode inclusive-transfer mac losing-isp/;

    my $response = undef;
    if ( defined $data_in{"mac"} && defined $data_in{"losing-isp"} ) {
        $response = $self->_make_request("migrate", $data);
    } else {
        $response = $self->_make_request("provide", $data);
    }

    my %order = ();
    foreach ( keys %{$response->{a}} ) {
        $order{$_} = $response->{a}->{$_}->{content};
    }
    return %order;
}

=head2 terms_and_conditions

Returns the terms-and-conditions to be presented to the user for signup
of a broadband product.

=cut

sub terms_and_conditions {
    return "XXX Get terms and conditions dynamically, or just put them here";
}

=head2 first_crd

    $murphx->first_crd( "order-type" => "provide", "product-id" => "1595" );

Returns the first possible date in ISO format an order of the specified
may be placed for.

Required Parameters:

    order-type : provide, migrate in, modify or cease
    product-id : the Murphx product ID

=cut

sub first_crd {
    my ($self, %args) = @_;

    my %leadtime = $self->leadtime(%args);

    return $leadtime{"first_date_text"};
}

=head2 leadtime

    $murphx->leadtime( "order-type" => "provide", "product-id" => "1595" );

Returns a hash detailing the leadtime and first date for an order of the
given type and for the given product.

Required Parameters:

    order-type : provide, migrate in, modify or cease
    product-id : the Murphx product ID

Returns:

    leadtime        : number of leadtime days
    first-date-int  : first date as seconds since unix epoch
    first-date-text : first date in ISO format

=cut

sub leadtime {
    my ($self, %args) = @_;

    my $response = $self->_make_request("leadtime", \%args);

    my %lead = ();

    foreach (keys %{$response->{a}}) {
        $lead{$_} = $response->{a}->{$_}->{content};
    }

    return %lead;
}

1;