Nabaztag - A module to interface your nabaztag!

 If you're behind a proxy, see LWP::Simple proxy issues to know how to deal with that.
 Basically, set env variable HTTP_PROXY to your proxi url in order to make it work.
 For instance : export HTTP_PROXY=http://my.proxy.company:8080/ 

    $ nabaztry.pl MAC TOKEN POSLEFT POSRIGHT

    use Nabaztag ; # OR
    # use Nabaztag { 'debug' => 1 } ;

    


    my $nab = Nabaztag->new();

    # MANDATORY
    $nab->mac($mac);
    $nab->token($tok);

    # See new function to have details about how to get these properties.

    $nab->leftEarPos($left);
    $nab->rightEarPos($right);

    $nab->syncState();

    $nab->sayThis("Demain, il pleuvra des grillons jusqu'a extinction totale de la race humaine.");
    .....

  mac : MAC Adress of nabaztag - equivalent to Serial Number ( SN ). Written at the back
        of your nabaztag !!
  token :  TOKEN Given by nabaztag.com to allow interaction with you nabaztag. See
           http://www.nabaztag.com/vl/FR/api_prefs.jsp to obtain yours !!
  leftEarPos : position of left ear.
  rightEarPos : position of right ear.

    my $nab = Nabaztag->new();
    $nab->mac($mac);
    $nab->token($token);
    $nab->fetchEars();

    print $nab->leftEarPos();
    print $nab->rightEarPos();

 See leftEarPos. Same but for right.

    $nab->syncState();

    $nab->sayThis("Demain, il pleuvra des grillons jusqu'a extinction totale de la race humaine."); # (example)

    my $url = $this->_cookUtl();

package Nabaztag;

use warnings;
use strict;

use base qw/Class::AutoAccess/ ;

use Carp ;

use LWP::UserAgent ;
use URI::Escape ;

our $VERSION = '0.03';
our $BASE_URL = "http://www.nabaztag.com/vl/FR/api.jsp" ;
our $ID_APP = 11 ;

my $debug = undef ;
sub import{
    #my $callerPack = caller ;
    my ($class, $options) = @_ ;
    if(  ! defined $debug ){
    	$debug = $options->{'debug'} || 0 ;
    }
    print "\n\nDebug option : $debug \n\n" if ($debug);
}


sub new {
    my ($class , $mac, $token ) = @_ ;
    
    my $self = {
	'mac' => undef , # MAC Adress of nabaztag - equivalent to Serial Number ( SN )
	'token' => undef , # TOKEN Given by nabaztag.com to allow interaction with you nabaztag
	'leftEarPos' => undef , # Position of left ear
	'rightEarPos' => undef  # Position of right ear
	};
    
    $self = bless $self, $class ;
    
    $self->mac($mac) ;
    $self->token($token);
    if( $self->mac() && $self->token() ){
	print "Trying to fetch ears position" if ( $debug );
	$self->fetchEars();
    }
    return $self ;
}

sub leftEarPos{
    my ($self, $pos) = @_ ;
    if( defined $pos ){
	if ( ( $pos >= 0 )  && ( $pos <= 16 )){
	    return $self->{'leftEarPos'} = $pos ;
	}else{
	    confess("Position has to be between 0 and 16");
	}
    }
    return $self->{'leftEarPos'} ;
}

sub rightEarPos{
    my ($self, $pos) = @_ ;
    if( defined $pos ){
	if ( ( $pos >= 0 )  && ( $pos <= 16 )){
	    return $self->{'rightEarPos'} = $pos ;
	}else{
	    confess("Position has to be between 0 and 16");
	}
    }
    return $self->{'rightEarPos'} ;
}

sub sendMessageNumber{
    my ($self, $num ) = @_ ;
    
    my $url =  $self->_cookUrl();
    unless( defined $num ){
	confess("No message number given");
    }
  
    $url .= '&idmessage='.$num ;

    print "Accessing URL : $url\n" if ($debug);

    my $content = $self->_getUserAgent->()->get($url)->content();
    
    print "content :".$content."\n" if ($debug);
    unless( defined $content ){
	confess("An error occured while processing request");
    }
}

sub syncState{
    my ($self) = @_ ;
    
    my $url = $self->_cookUrl();

    if( defined $self->leftEarPos() ){
	$url .=	'&posleft='.$self->leftEarPos() ;
    }
    if( defined $self->rightEarPos() ){
	$url .= '&posright='.$self->rightEarPos();
    }

    print "Getting url:".$url."\n" if ($debug);
    my $content = $self->_getUserAgent()->get($url)->content();
    print "Content:".$content."\n" if ($debug);
    unless( defined $content ){
	confess("An error occured while processing request");
    }
    
}

sub fetchEars{
    my ($self) = @_ ;
    
    my $url = $self->_cookUrl();
    $url .= '&ears=ok' ;
    
    print "Accessing: ".$url."\n" if ($debug);
    my $content = $self->_getUserAgent()->get($url)->content();
    print "Ear content \n".$content."\n" if ($debug);
    
    my ($left , $right) =  $content =~ /([0-9]+)/g  ;

    #print "Left :".$left."\n";
    #print "Right:".$right."\n";
    
    $self->leftEarPos($left);
    $self->rightEarPos($right);
    
}

sub sayThis{
    my ($self, $text ) = @_ ;
    my $url = $self->_cookUrl();
    $url .= '&tts='.uri_escape($text) ;
    my $content = $self->_getUserAgent()->get($url)->content();
    print "TTS: ".$content."\n" if ($debug);
}

sub danceThis{
    my ($self, $chor, $title) = @_ ;
    my $url = $self->_cookUrl();
    $url .= '&chor='.uri_escape($chor) ;
    $url .= '&chortitle='.uri_escape($title) if (defined $title);
    print "Getting url:".$url."\n" if ($debug);
    my $content = $self->_getUserAgent()->get($url)->content();
    print "Content :".$content."\n" if ($debug);
}

sub nabcastMessage{
    my ($self, $nabcastID, $title, $idmessage) = @_ ;
    my $url = $self->_cookUrl();
    
    $url .= '&nabcast='.$nabcastID ;
    $url .= '&nabcasttitle='.$title ;
    $url .= '&idmessage='.$idmessage ;
    
    print "Accessing :".$url."\n" if ($debug);
    my $content = $self->_getUserAgent()->get($url)->content();
    print "Content:".$content."\n" if ($debug) ;
}

sub nabcastText{
    my ($self, $nabcastID, $title, $text) = @_ ;
    my $url = $self->_cookUrl();
    
    $url .= '&nabcast='.$nabcastID ;
    $url .= '&nabcasttitle='.$title ;
    $url .= '&tts='.uri_escape($text) ;
    
    print "Getting url.".$url."\n" if ($debug);
    my $content = $self->_getUserAgent()->get($url)->content();
    print "Content:".$content."\n" if ($debug) ;
}

sub _cookUrl{
    my ($self) = @_ ;
    my $url =  $BASE_URL.'?idapp='.$ID_APP ;
    
    $self->_assume('mac');
    $self->_assume('token');
       
    $url .= '&sn='.$self->mac() ;
    $url .= '&token='.$self->token() ;

    return $url ;
}

sub _getUserAgent{
    my ($self) = @_ ;
    my $ua = LWP::UserAgent->new;
    $ua->timeout(60);
    $ua->env_proxy;
    $ua->default_headers->push_header('Accept-Language' => "fr");
    return $ua ;
}


sub _assume{
    my ($self, $propertie ) = @_ ;
    unless( defined $self->$propertie() ){
	confess($propertie." is not set in $self\n Please set it first !");
    }
}

1; # End of Nabaztag