Message/DOM/StringExtended.pm

package Message::DOM::StringExtended;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
push our @ISA, 'Message::IF::StringExtended', 'Exporter';
require Exporter;
our @EXPORT_OK = qw(find_offset16 find_offset32);

sub find_offset16 ($$) {
  my $v = ''.$_[0];
  my $offset32 = 0+$_[1];

  if ($offset32 < 0 or length $v < $offset32) {
    require Carp;
    Carp::croak ("String index out of bounds");
  }

  my $ss = substr $v, 0, $offset32;
  my $r = $offset32;
  if ($ss =~ /[\x{10000}-\x{10FFFF}]/) {
    while ($ss =~ /[\x{10000}-\x{10FFFF}]+/g) {
      $r += $+[0] - $-[0];
    }
  }
  
  return $r;
} # find_offset16

sub find_offset32 ($$) {
  my $v = ''.$_[0];
  my $offset16 = 0+$_[1];

  if ($offset16 < 0) {
    require Carp;
    Carp::croak ("String index out of bounds");
  }

  my $r = 0;
  my $o = $offset16;
  while ($o > 0) {
    my $c = substr ($v, $r, 1);
    if (length $c) {
      if ($c =~ /[\x{10000}-\x{10FFFF}]/) {
        $o -= 2;
      } else {
        $o--;
      }
      $r++;
    } else {
      require Carp;
      Carp::croak ("String index out of bounds");
    }
  }

  return $r;
} # find_offset32

package Message::IF::StringExtended;

=head1 LICENSE

Copyright 2007 Wakaba <w@suika.fam.cx>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1;
## $Date: 2007/07/08 05:42:37 $
1	wakaba	1.1	package Message::DOM::StringExtended;
2			use strict;
3			our $VERSION=do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4			push our @ISA, 'Message::IF::StringExtended', 'Exporter';
5			require Exporter;
6			our @EXPORT_OK = qw(find_offset16 find_offset32);
7
8			sub find_offset16 ($$) {
9			my $v = ''.$_[0];
10			my $offset32 = 0+$_[1];
11
12			if ($offset32 < 0 or length $v < $offset32) {
13			require Carp;
14			Carp::croak ("String index out of bounds");
15			}
16
17			my $ss = substr $v, 0, $offset32;
18			my $r = $offset32;
19			if ($ss =~ /[\x{10000}-\x{10FFFF}]/) {
20			while ($ss =~ /[\x{10000}-\x{10FFFF}]+/g) {
21			$r += $+[0] - $-[0];
22			}
23			}
24
25			return $r;
26			} # find_offset16
27
28			sub find_offset32 ($$) {
29			my $v = ''.$_[0];
30			my $offset16 = 0+$_[1];
31
32			if ($offset16 < 0) {
33			require Carp;
34			Carp::croak ("String index out of bounds");
35			}
36
37			my $r = 0;
38			my $o = $offset16;
39			while ($o > 0) {
40			my $c = substr ($v, $r, 1);
41			if (length $c) {
42			if ($c =~ /[\x{10000}-\x{10FFFF}]/) {
43			$o -= 2;
44			} else {
45			$o--;
46			}
47			$r++;
48			} else {
49			require Carp;
50			Carp::croak ("String index out of bounds");
51			}
52			}
53
54			return $r;
55			} # find_offset32
56
57			package Message::IF::StringExtended;
58
59			=head1 LICENSE
60
61			Copyright 2007 Wakaba <w@suika.fam.cx>
62
63			This program is free software; you can redistribute it and/or
64			modify it under the same terms as Perl itself.
65
66			=cut
67
68			1;
69			## $Date: 2007/07/08 05:42:37 $