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	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 $