view release on metacpan or  search on metacpan

lib/Data/Identifier/Util.pm  view on Meta::CPAN

        return Data::Identifier->new(from => $data);
    }

    if (defined($type) && defined($pack_template)) {
        my $len = length($data);
        my $exp;

        if ($pack_template eq 'C') {
            $exp = 1;
        } elsif ($pack_template eq 'n') {
            $exp = 2;
        } elsif ($pack_template eq 'N') {
            $exp = 4;
        }

        croak 'Input has bad length, expected '.$exp.' bytes, got '.$len unless $len == $exp;

        return Data::Identifier->new($type => unpack($pack_template, $data));
    }

    croak 'Unknown template: '.$template;
}


sub parse_sirtx {
    my ($self, $data, @opts) = _normalise_args(@_);

    croak 'Stray options passed' if scalar @opts;

    $self->_load_well_known;

    $data =~ s/^\[(.+)\]$/$1/;

    # Experimental:
    if (my ($d, $v) = $data =~ /^(\[.+?\]):(.+)$/) {
        $d = $self->parse_sirtx($d);
        $v =~ s/^\[(.+)\]$/$1/;
        return Data::Identifier->new($d => $v);
    }

    if ($data =~ /^'([0-9]*)$/) {
        my $num = int($1 || '0');
        require Data::Identifier::Generate;
        return Data::Identifier::Generate->integer($num);
    } elsif ($data =~ /^\/([0-9]+)$/) {
        return Data::Identifier->new('d73b6550-5309-46ad-acc9-865c9261065b' => int($1));
    } elsif ($data =~ /^(sid|sni):([0-9]+)$/) {
        return Data::Identifier->new($1 => int($2));
    } elsif ($data =~ /^uuid:([0-9a-fA-F-]+)$/) {
        return Data::Identifier->new(uuid => $1);
    } elsif ($data =~ /^wd:([QPL][1-9][0-9]*)$/) {
        return Data::Identifier->new(wd => $1);
    } elsif ($data =~ /^~([0-9]+)$/) {
        return Data::Identifier->new(hdi => int($1));
    } elsif ($data =~ /^raen:([0-9]+)$/) {
        return Data::Identifier->new('2bffc55d-7380-454e-bd53-c5acd525d692' => int($1));
    } elsif ($data =~ /^chat0w:([0-9]+)$/) {
        return Data::Identifier->new('2c7e15ed-aa2f-4e2f-9a1d-64df0c85875a' => int($1));
    } elsif ($data =~ /^asciicp:([0-9]+)$/) {
        require Data::Identifier::Generate;
        return Data::Identifier::Generate->unicode_character(ascii => int($1));
    } elsif ($data =~ /^raes:(.+)/) {
        if (defined(my $raen = $_raes_to_raen{$1})) {
            return Data::Identifier->new('2bffc55d-7380-454e-bd53-c5acd525d692' => $raen);
        }
    } elsif (defined $_logicals_to_sni{$data}) {
        return Data::Identifier->new(sni => $_logicals_to_sni{$data});
    } elsif (defined $_logicals_to_sid{$data}) {
        return Data::Identifier->new(sid => $_logicals_to_sid{$data});
    } elsif ($data =~ /^logical:(.+)$/) {
        $data = $1;
        if (defined $_logicals_to_sni{$data}) {
            return Data::Identifier->new(sni => $_logicals_to_sni{$data});
        } elsif (defined $_logicals_to_sid{$data}) {
            return Data::Identifier->new(sid => $_logicals_to_sid{$data});
        }
    }

    croak 'Unsupported/invalid SIRTX identifier';
}


sub render_sirtx {
    my ($self, $identifier, @opts) = _normalise_args(@_);
    state $map = [
        [sid        => Data::Identifier->new(wellknown => 'sid')->register],
        [sni        => Data::Identifier->new(wellknown => 'sni')->register],
        [wd         => Data::Identifier->new(wellknown => 'wd')->register],
        ['/'        => Data::Identifier->new(uuid => 'd73b6550-5309-46ad-acc9-865c9261065b')->register],
        [raen       => Data::Identifier->new(uuid => '2bffc55d-7380-454e-bd53-c5acd525d692')->register],
        [chat0w     => Data::Identifier->new(uuid => '2c7e15ed-aa2f-4e2f-9a1d-64df0c85875a')->register],
        ['~'        => Data::Identifier->new(wellknown => 'hdi')->register],
    ];

    croak 'Stray options passed' if scalar @opts;

    $identifier = Data::Identifier->new(from => $identifier);

    if (defined(my Data::Identifier $generator = $identifier->generator(default => undef)) && defined(my $req = $identifier->request(default => undef))) {
        if ($generator->eq('53863a15-68d4-448d-bd69-a9b19289a191')) {
            return sprintf('\'%u', $req);
        } elsif ($generator->eq('d74f8c35-bcb8-465c-9a77-01010e8ed25c') && $req =~ /^[Uu]\+([0-9a-fA-F]{4,6})$/) {
            my $cp = hex $1;
            if ($cp < 0x80) {
                return sprintf('asciicp:%u', $cp);
            }
        }
    }

    foreach my $ent (@{$map}) {
        my $v = $identifier->as($ent->[1], no_defaults => 1, default => undef) // next;
        $v = sprintf($ent->[0] =~ /^[a-z]/ ? '%s:%s' : '%s%s', $ent->[0], $v);
        $v = '['.$v.']' if $v =~ /-/;
        return $v;
    }

    # Fallback:
    return sprintf('[uuid:%s]', $identifier->uuid);
}

# Too experimental for listing in public API.