File Coverage

blib/lib/Net/OBEX/Packet/Headers/Unicode.pm

Criterion	Covered	Total	%
statement	28	29	96.5
branch	4	8	50.0
condition			n/a
subroutine	7	7	100.0
pod	2	2	100.0
total	41	46	89.1

package Net::OBEX::Packet::Headers::Unicode;

use strict;
use warnings;

use Carp;
use Encode qw(encode_utf8);

use base 'Net::OBEX::Packet::Headers::Base';

our $VERSION = '1.001001'; # VERSION

my %Header_HI_For = (
    name        => "\x01",
    description => "\x05",
);

sub new {
    my ( $class, $name, $value ) = @_;

    croak "Missing header name or HI identifier"
        unless defined $name;

    $name = $Header_HI_For{ lc $name }
        if exists $Header_HI_For{ lc $name };

    $value = ''
        unless defined $value;

    return bless {
        value  => $value,
        hi     => $name,
    }, $class;
}

sub make {
    my $self = shift;

    my $value = $self->value;
    unless ( length $value ) {
        return $self->hi . "\x00\x03";
    }

    $value = pack 'n*', unpack 'U*', encode_utf8($value);

    my $header = $self->hi; # header code
    $header .= pack 'n', 4 + length $value;
    $header .= $value . "\x00";
    return $self->header($header);
}

1;

__END__