package BGPmon::Translator::XFB2PerlHash;

use 5.006;
use strict;
use warnings;
use XML::LibXML::Simple;
use Data::Dumper;

BEGIN{
require Exporter;
    our $AUTOLOAD;
    our @ISA = qw(Exporter);
    our @EXPORT_OK = qw(translate_msg toString get_content reset get_error_code get_error_message get_error_msg);
    our $VERSION = '1.08';
}

#Variable to hold both the original as well as the converted XML
my $raw_xml = '';
my $xml_hashref = {};

#Variables to hold error codes and messages
my %error_code;
my %error_msg;
my @function_names = ('translate_msg', 'toString', 'get_content');

use constant NO_ERROR_CODE => 0;
use constant NO_ERROR_MSG => 'No Error. Life is good.';
use constant NO_MESSAGE_CODE => 601;
use constant NO_MESSAGE_MSG => 'No XML message provided';
use constant UNDEFINED_ARGUMENT_CODE => 602;
use constant UNDEFINED_ARGUMENT_MSG => 'Undefined argument';
use constant INVALID_FUNCTION_SPECIFIED_CODE => 603;
use constant INVALID_FUNCTION_SPECIFIED_MSG => 'Invalid Function Name Specified';
use constant PARSER_ERROR_CODE => 604;
use constant PARSER_ERROR_MSG => 'XML Parser Error';
use constant NO_SUCH_INFORMATION_CODE => 605;
use constant NO_SUCH_INFORMATION_MSG => 'No such element/attribute exists';

for my $function_name (@function_names) {
    $error_code{$function_name} = NO_ERROR_CODE;
    $error_msg{$function_name} = NO_ERROR_MSG;
}

=head1 NAME

BGPmon::Translator::XFB2PerlHash - convert an XFB message into a Perl hash

This module converts an XML message to a nested hash data structure
and provides an interface to get a stringified representation of
the data structure as well as the ability to extract individual subtrees
from the nested structure.

=head1 SYNOPSIS

use BGPmon::Translator::XFB2PerlHash;

 my $string = '<BGP_MESSAGE length="00002243" version="0.4" 
xmlns="urn:ietf:params:xml:ns:xfb-0.4" type_value="2" 
type="UPDATE"><BGPMON_SEQ id="0" seq_num="744909286"/><TIME 
timestamp="1336133702" datetime="2012-05-04T12:15:02Z" precision_time="0"/
><PEERING as_num_len="4"><SRC_ADDR><ADDRESS>2600:803::15</ADDRESS><AFI 
value="2">IPV6</AFI></SRC_ADDR><SRC_PORT>179</SRC_PORT><SRC_AS>701</
SRC_AS><DST_ADDR><ADDRESS>127.0.0.1</ADDRESS><AFI value="1">IPV4</AFI></
DST_ADDR><DST_PORT>179</DST_PORT><DST_AS>6447</DST_AS><BGPID>0.0.0.0</BGPID></
PEERING><ASCII_MSG length="110"><MARKER 
length="16">FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF</MARKER><UPDATE withdrawn_len="0" 
path_attr_len="87"><WITHDRAWN count="0"/><PATH_ATTRIBUTES count="5"><ATTRIBUTE 
length="1"><FLAGS transitive="TRUE"/><TYPE value="1">ORIGIN</TYPE><ORIGIN 
value="0">IGP</ORIGIN></ATTRIBUTE><ATTRIBUTE length="26"><FLAGS 
transitive="TRUE"/><TYPE value="2">AS_PATH</TYPE><AS_PATH><AS_SEG 
type="AS_SEQUENCE" length="6"><AS>701</AS><AS>12702</AS><AS>286</AS><AS>3549</
AS><AS>35994</AS><AS>35994</AS></AS_SEG></AS_PATH></ATTRIBUTE><ATTRIBUTE 
length="8"><FLAGS optional="TRUE" transitive="TRUE"/><TYPE 
value="7">AGGREGATOR</TYPE><AGGREGATOR><AS>0</AS><ADDR>192.8.8.2</ADDR></
AGGREGATOR></ATTRIBUTE><ATTRIBUTE length="8"><FLAGS optional="TRUE" 
transitive="TRUE"/><TYPE value="8">COMMUNITIES</
TYPE><COMMUNITIES><COMMUNITY><AS>701</AS><VALUE>333</VALUE></
COMMUNITY><COMMUNITY><AS>701</AS><VALUE>1020</VALUE></COMMUNITY></
COMMUNITIES></ATTRIBUTE><ATTRIBUTE length="28"><FLAGS optional="TRUE" 
extended="TRUE"/><TYPE value="14">MP_REACH_NLRI</TYPE><MP_REACH_NLRI><AFI 
value="2">IPV6</AFI><SAFI value="1">UNICAST</SAFI><NEXT_HOP_LEN>16</
NEXT_HOP_LEN><NEXT_HOP><ADDRESS>2600:803::15</ADDRESS></NEXT_HOP><NLRI 
count="1"><PREFIX label="DANN"><ADDRESS>2001:450:2030::/48</ADDRESS><AFI 
value="2">IPV6</AFI><SAFI value="1">UNICAST</SAFI></PREFIX></NLRI></
MP_REACH_NLRI></ATTRIBUTE></PATH_ATTRIBUTES><NLRI count="0"/></UPDATE></
ASCII_MSG><OCTET_MSG><OCTETS 
length="110">FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF006E02000000574001010040021A02060
00002BD0000319E0000011E00000DDD00008C9A00008C9AC0070800008C9AADDEE9FEC0080802B
D014D02BD03FC900E001C00020110260008030000000000000000000000150030200104502030
</OCTETS></OCTET_MSG></BGP_MESSAGE>';

my %hash = translate_msg($string);  #Converts and internally saves the message

print toString();   #pretty-prints the data

my $result = get_content('/BGP_MESSAGE/ASCII_MSG/MARKER/content');

print $$result;     #Would print 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'

$result = get_content
('/BGP_MESSAGE/ASCII_MSG/UPDATE/PATH_ATTRIBUTES/ATTRIBUTE/MP_REACH_NLRI/PREFIX');

print $res->{'ADDRESS'}->{'content'} foreach $res (@$result);

$result = get_content('/BGP_MESSAGE/PEERING');

print keys %$result;

reset();

=head1 EXPORT

translate_msg
toString
get_content
reset
get_error_code
get_error_msg
get_error_message

=head1 SUBROUTINES/METHODS

=head2 translate_msg

Converts an XML message into a Perl hash structure while maintaining the 
structure of the message itself.

Input:      The XML string to be parsed

Output:     A perl hash structure that contains the converted string
            or an empty hash if there is no string provided or the
                XML parser fails

=cut

sub translate_msg{
    my $xml_msg = shift;
    my $fname = 'translate_msg';
    if( !defined($xml_msg) ){
        $error_code{$fname} = NO_MESSAGE_CODE;
        $error_msg{$fname} = NO_MESSAGE_MSG;
        return {};
    }
    #Reset the state variables
    %$xml_hashref = ();
    $raw_xml = '';
    #Store the XML message
    $raw_xml = $xml_msg;
    #Instantiates a new LibXML::Simple object
    my $xml = new XML::LibXML::Simple;
    #XMLin converts the XML to a nested hash
    #the ForceArray option forces the listed tags to be represented
    #as arrays so that the user can iterate through them
    my $data = ();
    eval{
        $data = $xml->XMLin("$xml_msg",ForceArray => ['PREFIX','ATTRIBUTE','AS_SEG','AS'],
KeepRoot => 1 , ForceContent => 1);
        $data->{'raw'} = $raw_xml;  #Saves the raw XML in the hash structure
        $xml_hashref = $data;
        return $xml_hashref;
    } or do {
        $error_code{$fname} = PARSER_ERROR_CODE;
        $error_msg{$fname} = PARSER_ERROR_MSG . ": $?";
        return {};
    };
}

=head2 toString

Returns a printable version of the most recent XML message that was parsed with
translate_msg.  If there is no such message, returns the empty string.

=cut
sub toString{
    my $fname = 'toString';
    if( !keys %$xml_hashref ){
        $error_code{$fname} = NO_MESSAGE_CODE;
        $error_msg{$fname} = NO_MESSAGE_MSG;
        return '';
    }
    return Dumper($xml_hashref);
}

=head2 get_content

Returns a reference to an element or attribute of the most recent XML message
translated via translate_msg.

Input:      A slash-delimited string which gives the path through
            the message tree structure, i.e. 
            "/ROOT_TAG/NEXT_TAG/attribute_name"
            NOTE: To get the text contents of an element, specify "/content"
                as the final "node" in the target string.

Output:     A reference to the appropriate content if found.
            undef if no such information is found

=cut
sub get_content{
    my $target_loc = shift;
    my $fname = 'get_content';

    if( !keys %$xml_hashref ){
        $error_code{$fname} = NO_MESSAGE_CODE;
        $error_msg{$fname} = NO_MESSAGE_MSG;
        return undef;
    }

    if( !defined($target_loc) ){
        $error_code{$fname} = UNDEFINED_ARGUMENT_CODE;
        $error_msg{$fname} = UNDEFINED_ARGUMENT_MSG;
        return undef;
    }
    #Extract the node names from the input by splitting on forward slashes
    my @path = split "/",$target_loc;
    shift @path;     #Removes the leading blank space from path
    #Now initialize a new hash reference to use to iteratively step
    #through the XML hash
    my $new_hashref = $xml_hashref;
    ELEMENT: foreach my $el (@path){
        #If we encounter an array in the hash structure
        #we need to go through it and see if any element
        #has the next element in the chain in it.
        if( ref $new_hashref eq 'ARRAY' ){
            foreach my $attr (@$new_hashref){
                #If the next element is found, we can move the hashref
                if( exists $attr->{"$el"} ){
                    $new_hashref = $attr;
                    last;
                }
            }
        }
        #Otherwise we try to dereference the next element in the chain.
        #If the array runs out or we give a hash element that isn't there,
        #catch it, set the error, and return.
        eval{ 
            $new_hashref = $new_hashref->{"$el"};
            1;
        } or do {
            $error_code{$fname} = NO_SUCH_INFORMATION_CODE;
            $error_msg{$fname} = NO_SUCH_INFORMATION_MSG;
            return undef;
        };
    }
    if( defined $new_hashref ){
        $error_code{$fname} = NO_ERROR_CODE;
        $error_msg{$fname} = NO_ERROR_MSG;
        return $new_hashref;
    }
    else{
        $error_code{$fname} = NO_SUCH_INFORMATION_CODE;
        $error_msg{$fname} = NO_SUCH_INFORMATION_MSG;
        return undef;
    }
}

=head2 reset

Resets the module's state variables

=cut

sub reset{
    $raw_xml = '';
    %$xml_hashref = ();
    for my $function_name (@function_names) {
        $error_code{$function_name} = NO_ERROR_CODE;
        $error_msg{$function_name} = NO_ERROR_MSG;
    }
    return;
}

=head2 get_error_code

Get the error code for some function

Input : the name of the function whose error code we should report

Output: the function's error code 
        or UNDEFINED_ARGUMENT if the user did not supply a function
        or INVALID_FUNCTION_SPECIFIED if the user provided an invalid function name
=cut

sub get_error_code {
    my $function = shift;

    # check we got a function name
    if (!defined($function)) {
        return UNDEFINED_ARGUMENT_CODE;
    }

    return $error_code{$function} if defined $error_code{$function};
    return INVALID_FUNCTION_SPECIFIED_CODE;
}

=head2 get_error_message

Get the error message for some function

Input : the name of the function whose error message we should report

Output: the function's error message
        or UNDEFINED_ARGUMENT if the user did not supply a function
        or INVALID_FUNCTION_SPECIFIED if the user provided an invalid function name
=cut

sub get_error_message {
    my $function = shift;

    # check we got a function name
    if (!defined($function)) {
        return UNDEFINED_ARGUMENT_MSG;
    }

    return $error_msg{$function} if defined($error_msg{$function});
    return INVALID_FUNCTION_SPECIFIED_MSG.": $function";
}

=head2 get_error_msg

Get the error message

This function is identical to get_error_message
=cut
sub get_error_msg {
    my $msg = shift;
    return get_error_message($msg);
}

=head1 ERROR CODES AND MESSAGES

The following error codes and messages are defined:

    0:  No Error
        'No Error. Life is good.'

    601:    There has been no XML message passed through translate_msg
        'No XML message provided'

    602:    No argument was passed to a function expecting one
        'Undefined argument'

    603:    An invalid function name was passed to get_error_[code/message/msg]
        'Invalid Function Name Specified'

    604:    The XML parser failed
        'XML Parser Error'

    605:    There was no information found at the location passed to 
get_content
        'No such element/attribute exists'

=head1 AUTHOR

Jason Bartlett, C<< <bartletj at cs.colostate.edu> >>

=head1 BUGS

Please report any bugs or feature requests to
 C<bgpmon at netsec.colostate.edu>, or through
the web interface at L<http://bgpmon.netsec.colostate.edu>.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc BGPmon::Translator::XFB2PerlHash

=cut

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2012 Colorado State University

    Permission is hereby granted, free of charge, to any person
    obtaining a copy of this software and associated documentation
    files (the "Software"), to deal in the Software without
    restriction, including without limitation the rights to use,
    copy, modify, merge, publish, distribute, sublicense, and/or
    sell copies of the Software, and to permit persons to whom
    the Software is furnished to do so, subject to the following
    conditions:

    The above copyright notice and this permission notice shall be
    included in all copies or substantial portions of the Software.

    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
    EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
    OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
    NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
    HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
    WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
    FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
    OTHER DEALINGS IN THE SOFTWARE.\

    File: XFB2PerlHash.pm

    Authors: Jason Bartlett, Kaustubh Gadkari, Dan Massey, Cathie Olschanowsky
    Date: 11 July 2012
=cut

1; # End of BGPmon::Translator::XFB2PerlHash