view release on metacpan or  search on metacpan

lib/Device/Gsm/Pdu.pm  view on Meta::CPAN

    my $str;
    while ($text8) {
        $str .= chr(hex(substr $text8, 0, 2));
        if (length($text8) > 2) {
            $text8 = substr($text8, 2);
        }
        else {
            $text8 = '';
        }
    }
    return $str;
}

sub encode_address {
    my $num     = shift;
    my $type    = '';
    my $len     = 0;
    my $encoded = '';

    $num =~ s/\s+//g;

    #warn('encode_address('.$num.')');

    # Check for alphabetical addresses (TS 03.38)
    if ($num =~ /[A-Z][a-z]/) {

        # Encode clear text in gsm0338 7-bit
        $type    = 'D0';
        $encoded = encode_text7($num);
        $len     = unpack 'H2' => chr(length $encoded);
    }
    else {
        $type = index($num, '+') == 0 ? 91 : 81;

        # Remove all non-numbers. Beware to GPRS dialing chars.
        $num =~ s/[^\d\*#]//g;
        $num =~ s/\*/A/g;        # "*" maps to A
        $num =~ s/#/B/g;         # "#" maps to B

        $len = unpack 'H2' => chr(length $num);
        $num .= 'F';
        my @digit = split // => $num;

        while (@digit > 1) {
            $encoded .= join '', reverse splice @digit, 0, 2;
        }
    }

    #warn('   [' . (uc $len . $type . $encoded ) . ']' );

    return (uc $len . $type . $encoded);
}

sub decode_text_UCS2 {
    my $encoded = shift;
    return undef unless $encoded;

    my $len = hex substr($encoded, 0, 2);
    $encoded = substr $encoded, 2;

    my $decoded = "";
    while ($encoded) {
        $decoded .= pack("C0U", hex(substr($encoded, 0, 4)));
        $encoded = substr($encoded, 4);
    }
    return $decoded;
}

sub encode_text7 {
    uc
        unpack 'H*',
        pack 'C b*',
        length $_[0],
        join '',
        unpack '(b7)*', $_[0];
}

#
#return complete ud with udh
#remains for comatibility reasons with my production scripts :)
#
sub encode_text7_udh1 {
    my $decoded        = shift;
    my $udh1           = shift;
    my $decoded_length = length($decoded);
    $decoded = Device::Gsm::Charset::iso8859_to_gsm0338($decoded);
    my $pdu_msg = uc
        unpack 'H*',
        pack 'b*',

        #add one bit of padding to align septet boundary
        '0' . join '', unpack '(b7)*', $decoded;

    #below add 7 septets length for udh1
    return
          sprintf("%02X", $decoded_length + Sms::Token::UDH::UDH1_LENGTH)
        . $udh1
        . $pdu_msg;
}

#
#encode text with padding
#
sub encode_text7_udh {
    my $decoded = shift;
    my $padding = shift;
    $padding = 0 unless ($padding);
    my $decoded_length = length($decoded);
    $decoded = Device::Gsm::Charset::iso8859_to_gsm0338($decoded);
    my $pdu_msg = uc
        unpack 'H*',
        pack 'b*',

        #add bits of padding to align septet boundary
        '0' x $padding . join '', unpack '(b7)*', $decoded;

    #below add septets length of text
    my $len_hex = sprintf("%02X", $decoded_length);
    return
        wantarray
        ? ($len_hex, $pdu_msg, $len_hex . $pdu_msg)
        : $len_hex . $pdu_msg;
}

sub pdu_to_latin1 {

    # Reattach a length octet.
    my $s   = shift;
    my $len = length $s;

    #arn "len=$len, len/2=", $len/2, "\n";
    my $l = uc unpack("H*", pack("C", int(length($s) / 2 * 8 / 7)));
    if (length($l) % 2 == 1) { $l = '0' . $l }
    my $pdu = $l . $s;

    #arn "l=$l, pdu=$pdu\n";
    my $decoded = Device::Gsm::Pdu::decode_text7($pdu);

    #arn "decoded_text7=$decoded\n";
    my $latin1 = Device::Gsm::Charset::gsm0338_to_iso8859($decoded);

    #arn "latin1=$latin1\n";
    return $latin1;
}

sub latin1_to_pdu {
    my $latin1_text = $_[0];

    #arn "latin1=$latin1_text\n";
    my $gsm0338 = Device::Gsm::Charset::iso8859_to_gsm0338($latin1_text);

    #arn "gsm0338=$gsm0338\n";
    my $fullpdu = Device::Gsm::Pdu::encode_text7($gsm0338);

    #arn "pdu=$fullpdu\n";
    return substr($fullpdu, 2);    # strip off the length octet
}

1;

=head1 NAME

Device::Gsm::Pdu - library to manage PDU encoded data for GSM messaging

=head1 WARNING 

   This is C<BETA> software, still needs extensive testing and
   support for custom GSM commands, so use it at your own risk,
   and without C<ANY> warranty! Have fun.

=head1 NOTICE

    This module is meant to be used internally by C<Device::Gsm> class,
    so you probably do not want to use it directly.

=head1 SYNOPSIS

  use Device::Gsm::Pdu;

  # DA is destination address
  $DA = Device::Gsm::Pdu::encode_address('+39347101010');
  $number = Device::Gsm::Pdu::decode_address( $DA );

  # Encode 7 bit text to send messages
  $text = Device::Gsm::Pdu::encode_text7('hello');

=head1 DESCRIPTION

C<Device::Gsm::Pdu> module includes a few basic functions to deal with SMS in PDU mode,
such as encoding GSM addresses (phone numbers) and, for now only, 7 bit text.

=head1 FUNCTIONS

=head2 decode_address( pdu_encoded_address )

Takes a PDU encoded address and decodes into human-readable mobile number.
If number type is international, result will be prepended with a `+' sign.

Clearly, it is intended as an internal function.