← Back to branch summary

~ubuntu-branches/ubuntu/raring/libunicode-collate-perl/raring-proposed

« back to all changes in this revision

Viewing changes to gendata/dumpstr

  • Committer: Bazaar Package Importer
  • Author(s): Danai SAE-HAN (韓達耐)
  • Date: 2010-11-04 21:58:23 UTC
  • Revision ID: james.westby@ubuntu.com-20101104215823-wr6wrwudp0em3fm4
Tags: upstream-0.66
Import upstream version 0.66

Show diffs side-by-side

added added

removed removed

Lines of Context:
gendata/dumpstr
 
1
#!perl
 
2
use strict;
 
3
use warnings;
 
4
no warnings 'utf8';
 
5
 
 
6
sub unidump { join(' ', map { sprintf '%04X', $_ } unpack 'U*', shift) }
 
7
 
 
8
sub element {
 
9
    my $s = shift;
 
10
    my $u = unidump($s);
 
11
    for ($u) {
 
12
        s/\b00([46][1-9A-F]|[57][0-9A])\b/'{'.chr(hex $1).'}'/ge;
 
13
        s/\ \{/{/g;
 
14
        s/\}\ /}/g;
 
15
        s/\}\{//g;
 
16
    }
 
17
    return $u;
 
18
}
 
19
 
 
20
sub string {
 
21
    my $s = shift;
 
22
    my $ret = '"';
 
23
    my @c = split //, $s;
 
24
    for (@c) {
 
25
        if (/^[\x20-\x7E]\z/) {
 
26
            $ret .= "\\" if !/^[0-9A-Za-z_]\z/;
 
27
            $ret .= $_;
 
28
        } elsif (/^[\x80-\xFF]\z/) {
 
29
            my $temp = @c == 1 ? "'U'" : "'U*'";
 
30
            my $hexa = join ', ', map sprintf("0x%X", $_), unpack('U*', $s);
 
31
            return "pack($temp, $hexa)";
 
32
        } else {
 
33
            $ret .= sprintf '\x{%X}', unpack 'U', $_;
 
34
        }
 
35
    }
 
36
    $ret .= '"';
 
37
    return $ret;
 
38
}
 
39
 
 
40
1;