The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Net::OBEX::Packet::Request::SetPath;

use strict;
use warnings;

use Carp;
use base 'Net::OBEX::Packet::Request::Base';
our $VERSION = '1.001001'; # VERSION

sub new {
    my $class = shift;
    croak "Must have even number of arguments to new()"
        if @_ & 1;
    my %args = @_;
    $args{ +lc } = delete $args{ $_ } for keys %args;

    %args = (
        do_up     => 0,
        no_create => 1,
        constants => "\x00",
        headers   => [],

        %args,
    );

    my $self = bless \%args, $class;

    my $flags = $args{no_create} ? '1' : '0';
    $flags .= $args{do_up}      ? '1' : '0';
    $self->flags( pack 'B8', '000000' . $flags );

    return $self;
}

sub make {
    my $self = shift;

    my $packet;
    my $headers = join '', @{ $self->headers };
    if ( $self->do_up and not length $headers ) {
        $packet = $self->flags . $self->constants;
    }
    else {
        $packet = $self->flags . $self->constants . $headers;
    }

    return $self->raw("\x85" . pack('n', 3 + length $packet) . $packet);
}

sub flags {
    my $self = shift;
    if ( @_ ) {
        $self->{ flags } = shift;
    }
    return $self->{ flags };
}

sub do_up {
    my $self = shift;
    if ( @_ ) {
        $self->{ do_up } = shift;
    }
    return $self->{ do_up };
}

sub constants {
    my $self = shift;
    if ( @_ ) {
        $self->{ constants } = shift;
    }
    return $self->{ constants };
}

sub no_create {
    my $self = shift;
    if ( @_ ) {
        $self->{ no_create } = shift;
    }
    return $self->{ no_create };
}

1;

__END__



=head1 NAME

Net::OBEX::Packet::Request::SetPath - create OBEX protocol C<SetPath> request packets.

=head1 SYNOPSIS

    use Net::OBEX::Packet::Request::SetPath;

    my $pack= Net::OBEX::Packet::Request::SetPath->new(
        headers => [ $bunch, $of, $raw, $headers ],
    );

    my $setpath_packet = $pack->make;

    $pack->headers([]); # reset headers.
    $pack->do_up(1);    # set the "backup a level before applying name"
    $pack->no_create(0); # unset the "don't create" flag

    my $empty_abort = $aborts->make;

=head1 DESCRIPTION

B<WARNING!!! This module is in an early alpha stage. It is recommended
that you use it only for testing.>

The module provides means to create OBEX protocol C<SetPath>
(C<0x85>) packets.
It is used internally by L<Net::OBEX::Packet::Request> module and you
probably want to use that instead.

=head1 CONSTRUCTOR

=head2 new

    $pack = Net::OBEX::Packet::Request::SetPath->new;

    $pack2 = Net::OBEX::Packet::Request::SetPath->new(
        do_up     => 0,
        no_create => 1,
        constants => "\x00",
        headers   => [ $some, $raw, $headers ],
    );

Returns a Net::OBEX::Packet::Request::SetPath object, takes
several optional arguments which are as follows:

=head3 headers

    $pack2 = Net::OBEX::Packet::Request::SetPath->new(
        headers   => [ $some, $raw, $headers ],
    );

B<Optional>. Takes an arrayref as a value, elements of which are raw OBEX
packet headers. See L<Net::OBEX::Packet::Headers> if you want to create
those. B<Defaults to:> C<[]> (no headers)

=head3 do_up

    $pack2 = Net::OBEX::Packet::Request::SetPath->new( do_up => 1 );

B<Optional>. Indicates whether or not the I<backup a level before
applying name> flag bit should be set. B<Defaults to:> C<0>

=head3 no_create

    $pack2 = Net::OBEX::Packet::Request::SetPath->new( no_create => 0 );

B<Optional>. Indicates whether or not the I<don't create directory if it
does not exist, return an error instead> flag bit should be set.
B<Defaults to:> C<1>

=head3 constants

    $pack2 = Net::OBEX::Packet::Request::SetPath->new(
        constants => "\x00",
    );

B<Optional>. Takes a byte representing packet constants. Currently those
are reserved so you probably shouldn't be using this. B<Defaults to:>
C<"\x00"> (all bits set to zero)

=head1 METHODS

=head2 make

    my $raw_packet = $pack->make;

Takes no arguments, returns a raw OBEX packet ready to go down the wire.

=head2 raw

    my $raw_packet = $pack->raw;

Takes no arguments, must be called after C<make()> call, returns the
raw OBEX packet which was made with last C<make()> (i.e. the last
return value of C<make()>).

=head1 ACCESSORS/MUTATORS

=head2 headers

    my $headers_ref = $pack->headers;

    $pack->headers( [ $bunch, $of, $raw, $headers ] );

Returns an arrayref of currently set OBEX packet
headers. Takes one optional argument which is an arrayref, elements of
which are raw OBEX
packet headers. See L<Net::OBEX::Packet::Headers> if you want to create
those. If you want a packet with no headers use an empty arrayref
as an argument.

=head2 do_up

    my $old_do_up_flag = $pack->do_up;

    $pack->do_up( 1 );

Returns either true or false value indicating whether or not the
I<backup a level before applying name> flag bit is set. Takes one
optional argument which is either a true or false value indicating
whether or not the I<backup a level before applying name> flag bit
should be set in the next generated packet.

=head2 no_create

    my $old_no_create_flag = $pack->no_create;

    $pack->no_create(0);

Returns either true or false value indicating whether or not the
I<don't create directory if it does not exist, return an error instead>
flag bit is set. Takes one
optional argument which is either a true or false value indicating
whether or not the I<don't create directory if it
does not exist, return an error instead> flag bit
should be set in the next generated packet.

=head2 constants

    my $old_constants = $pack->constants;

    $pack->constants( "\x00" );

Returns a byte representing currently set packet "constants".
Takes a one byte value representing packet "constants" bit which will
be present in the next generated packets. Currently all constants
are reserved so you probably shouldn't be using this.

=head2 flags

    my $old_flags = $pack->flags;

    $pack->flags( pack 'B*', '11000000' );

Returns a byte representing currently set flags (that is the
C<do_up()> and C<no_create()> flags plus six more reserved bytes).
Takes one optional argument which is a byte representing packet "flags"
byte. Use the C<do_up()> and C<no_create()> methods to set the only
two non-reserved flags.

=head1 REPOSITORY

Fork this module on GitHub:
L<https://github.com/zoffixznet/Net-OBEX>

=head1 BUGS

To report bugs or request features, please use
L<https://github.com/zoffixznet/Net-OBEX/issues>

If you can't access GitHub, you can email your request
to C<bug-Net-OBEX at rt.cpan.org>

=head1 AUTHOR

Zoffix Znet <zoffix at cpan.org>
(L<http://zoffix.com/>, L<http://haslayout.net/>)

=head1 LICENSE

You can use and distribute this module under the same terms as Perl itself.
See the C<LICENSE> file included in this distribution for complete
details.

=cut