File Coverage

blib/lib/Net/OBEX/FTP.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Net::OBEX::FTP;

use strict;
use warnings;

our $VERSION = '1.001001'; # VERSION

use Carp;
use Net::OBEX;
use XML::OBEXFTP::FolderListing;
use base qw(Class::Data::Accessor);

__PACKAGE__->mk_classaccessors( qw(
        obex
        response
        error
        pwd
        xml
        folders
        files
    )
);

sub new {
    my $class = shift;

    my $self =  bless {}, $class;
    $self->obex( Net::OBEX->new );
    $self->xml( XML::OBEXFTP::FolderListing->new );
    return $self;
}

sub connect {
    my $self = shift;
    croak "Must have even number of arguments to connect()"
        if @_ & 1;

    my %args = @_;
    $args{ +lc } = delete $args{ $_ } for keys %args;

    croak "Missing `address` argument to connect()"
        unless exists $args{address};

    croak "Missing `port` argument to connect()"
        unless exists $args{port};

    %args = (
        mtu     => 4096,
        version => "\x10",

        %args,
    );

    $self->error(undef);

    my %response;

    my $obex = $self->obex;
    $response{connect} = $obex->connect(
        mtu     => $args{mtu},
        version => $args{version},
        address => $args{address},
        port    => $args{port},
        target  => 'F9EC7BC4953C11D2984E525400DC9E09', # OBEX FTP UUID
    ) or return $self->_set_error('Failed to connect: ' . $obex->error);

    $self->_is_success( \%response, 'connect' )
        or return;

    $response{set_path} = $obex->set_path
        or return $self->_set_error('Failed to set path: ' . $obex->error);

    $self->_is_success( \%response, 'set_path' )
        or return;

    $self->pwd([]);

    $response{get} = $obex->get( type => 'x-obex/folder-listing' )
        or return $self->_set_error(
            'Failed to get folder listing: ' . $obex->error
        );

    my $xml = $self->xml;
    $xml->parse($response{get}{body});
    $self->folders( $xml->folders );
    $self->files( $xml->files );
    return $self->response( \%response );
}

sub cwd {
    my $self = shift;

    my %args;
    if ( @_ & 1 ) {
        $args{path} = shift;
    }
    else {
        %args = @_;
        $args{ +lc } = delete $args{ $_ } for keys %args;
    }

    $self->error(undef);

    my $obex = $self->obex;

    my %response;

    $response{set_path} = $obex->set_path( %args )
        or return $self->_set_error('Failed to set path: ' . $obex->error );

     $self->_is_success( \%response, 'set_path' )
         or return;

    my $pwd_ref = $self->pwd;
    if ( defined $args{path} and length $args{path} ) {
         push @$pwd_ref, $args{path};
    }
    elsif ( defined $args{do_up} ) {
         pop @$pwd_ref;
    }
    else {
        $pwd_ref = [];
    }
    $self->pwd( $pwd_ref );

    $response{get} = $obex->get( type => 'x-obex/folder-listing' )
        or return $self->_set_error(
            'Failed to get folder listing: ' . $obex->error
        );

    my $xml = $self->xml;

    $xml->parse( $response{get}{body} );
    $self->files( $xml->files );
    $self->folders( $xml->folders );

    return $self->response( \%response );
}

sub get {
    my ( $self, $what, $fh ) = @_;

    $self->error(undef);

    my $obex = $self->obex;
    my $response_ref = $obex->get(
        name => $what,
        defined $fh ? ( file => $fh ) : (),
    ) or return $self->_set_error( 'Failed to get: ' . $obex->error );

    return $self->response( $response_ref );
}

sub _is_success {
    my ( $self, $response_ref, $type ) = @_;
    unless( $response_ref->{ $type }{info}{response_code} == 200 ) {
        my ($code, $meaning)
        = @{ $response_ref->{ $type }{info} }{
            qw( response_code  response_code_meaning )
        };

        $self->response( $response_ref );
        $self->error( "Failed to connect: ($code) $meaning" );
        return 0;
    }
    return 1
}

sub _set_error {
    my ( $self, $error ) = @_;
    $self->error( $error );
    return;
}

sub close {
    my $self = shift;
    $self->obex->close( @_ );
}

1;

__END__