util.pm

Punjab is a jabber XMLRPC/SOAP/REST client. It is a xmlrpc, soap, or REST server that allows for p

package PunJab::Util;
=head1 NAME

Util - 

=head1 SYNOPSIS

Not done

=head1 DESCRIPTION

This package provides various filtering, debugging and logging mechanisms 


=cut


use POE::Filter::XML;
use POE::Filter::XML::Node;
use POE::Filter::XML::NS qw/ :JABBER :IQ /;
use POE::Filter::XML::Utils;

use Carp;
use IO::String;
use Data::Dumper;
use Crypt::CBC;
use URI;
use URI::QueryParam;
use PunJab::Session;

require Exporter;
########################################
# DEFINE GLOBAL CONSTANTS
########################################

our $VERSION = '0.4';
our @ISA = qw/ Exporter /;

our @EXPORT = qw/NAME VERSION TRUE FALSE
    &print_dump &debug &str_to_node  &send_error 
    &trim_jid &toFrom &parse_jid &encrypt_password &decrypt_password 
    &stdin_to_node $punjab_session/;

########################################
# SET UP GLOBAL VARIABLES
#########################################

use constant TRUE => 1;
use constant FALSE => 0;

use constant NAME    => 'PunJab - A jabber SOAP/XMLRPC/REST/HTTP client interface.';

our $punjab_session = new PunJab::Session;

########################################
#
# GENERAL PURPOSE METHODS
#
########################################


# -----------------------------------------------------------------------------
# toFrom - reverse to and from attributes
# -----------------------------------------------------------------------------
sub toFrom
{
    my $node = shift;
    my $to = $node->attr('to');
    $node->attr('to',$node->attr('from'));
    $node->attr('from',$to);
    return $node;
}

# -----------------------------------------------------------------------------
# trimJID - trim the Resource from the JID 
# -----------------------------------------------------------------------------
sub trimJid {

    # Get JID
    my $jid = shift;

    # Trim off the resource
    $jid =~ s|/.*$||;

    return $jid;

}


# -----------------------------------------------------------------------------
#
# -----------------------------------------------------------------------------
sub send_error
{
    my $node  = shift;
    my $error = shift;
    my $code  = shift;
    
    my $to   = $node->attr('to');
    my $from = $node->attr('from');


    $node->attr('type', +IQ_ERROR);
	    
    $node->attr('to' => $from);
    $node->attr('from' => $to);
    
    my $err = $node->insert_tag('error');
    $err->attr('code' => $code);
    $err->data($error);	    
   
    return $node;
}

# -----------------------------------------------------------------------------
# str_to_node - turns an xml string to a node or an content string to a node
# -----------------------------------------------------------------------------
sub str_to_node 
{
    my $string = shift;

    $io = IO::String->new($string);
    my $filter = POE::Filter::XML->new();
    my @lines = $io->getlines();
    
    my $nodes = $filter->get(\@lines);
    
    if (not defined($nodes)) {
        &debug("str_to_node : Error in xml".$@);
        return;
    }
    # this needs testing!

    my $tnode = shift(@$nodes);
    my $attrs = $tnode->get_attrs();
    
    my $node  = POE::Filter::XML::Node->new($tnode->name()); 
    #$node->insert_attrs($attrs) if defined $attrs;
    foreach my $a (keys %$attrs)
    {
	$node->attr($a,$attrs->{$a});
    }
    $node->data($tnode->data());
    pop(@$nodes); # get reid of end
    foreach my $n (@$nodes)
    {
	$node->insert_tag($n);
    }
    return $node;
}



# -----------------------------------------------------------------------------
# stdin_to_node - turns an xml string to a node or an content string to a node
# -----------------------------------------------------------------------------
sub stdin_to_node 
{
    my $string = shift;
    $io = IO::String->new($string);
    my $filter = POE::Filter::XML->new(undef,undef);
    my @lines = $io->getlines();

    my ($nodes,$tnode);
    eval {
	$nodes = $filter->get(\@lines);
	$tnode = shift(@$nodes);
    };  
   
    if (not defined($tnode)) {
        return &content_to_node($string); # try to parse if it is request content
    }
        # this needs testing!

    my $node  = POE::Filter::XML::Node->new($tnode->name());
    pop(@$nodes); # get reid of end
    foreach my $n (@$nodes)
    {
	$node->insert_tag($n);
    }
    return $node;
}

sub content_to_node
{
    my $string = shift;

    my $stdin  = POE::Filter::XML::Node->new('stdin');
        
    $u = URI->new("", "http");
    $u->query($string);
    
    for my $key ($u->query_param) {
	$stdin->insert_tag($key)->data($u->query_param($key));
    }

    return $stdin;

}

#sub node2hash {
#    my $node = shift;
#    my $hash = {};
#    return $node->data() unless @{$node->get_children} >0;
#    foreach my $kid ($node->get_children) {
#	$hash->{$kid->name()} = &node2hash($kid);
#    }
#    return $hash;
#}

# ----------------------------------------------------------------------
# debug - send debug message
# ----------------------------------------------------------------------
sub debug {
    # maybe add the class?
    print STDERR "Util::debug : " , @_ , "\n";
}

sub print_dump 
{
    my $data = shift;

    print Dumper \$data;

}



#################################################################################   

sub encrypt_password {
    my $password = shift;
    my $config   = shift; 
   
    my $cipher   = Crypt::CBC->new( {'key'            => $config->{server}->{secret}."123456789", 
				     'cipher'         => 'Blowfish',
				     'iv'             => '$KJh#(}q',
				     'regenerate_key' => 0,   # default true                                
				     'padding'        => 'space',
				     'prepend_iv'     => 0
				     });
    my $ciphertext = $cipher->encrypt("$password");
    
    return $ciphertext;
}


sub decrypt_password {
    my $config   = shift;
    my $password = shift;

    my $cipher = Crypt::CBC->new( {'key'           => $config->{server}->{secret}."123456789", 
				   'cipher'        => 'Blowfish',
				   'iv'            => '$KJh#(}q',
				   'regenerate_key'=> 0,   # default true                                
				   'padding'       => 'space',
				   'prepend_iv'    => 0
                                });

    my $plaintext = $cipher->decrypt($password);
    return $plaintext;
}




#################################################################################   


sub parse_jid {
    my $destination = shift;
    return ($destination =~ /^([^\@\/'"&:<>]*)\@([A-Za-z0-9\.-]+)\/?(.*?)$/);
}


1;