root/lang/perl/Data-Model/trunk/lib/Data/Model/Schema/Inflate.pm @ 30388

Revision 29437, 1.0 kB (checked in by yappo, 5 years ago)

add Inflate/UUID

Line 
1package Data::Model::Schema::Inflate;
2use strict;
3use warnings;
4
5use Carp ();
6
7sub import {
8    my $class  = shift;
9    my $caller = caller;
10
11    no strict 'refs';
12    *{"$caller\::inflate_type"} = \&inflate_type;
13}
14
15my %INFLATE = (
16    inflate => {
17        URI  => sub { URI->new($_[0]) },
18        Hex  => sub { unpack("H*", $_[0]) },
19    },
20    deflate => {
21        URI  => sub { $_[0]->as_string },
22        Hex  => sub { pack("H*", $_[0]) },
23    },
24);
25
26sub get_inflate {
27    my($class, $name) = @_;
28    $INFLATE{inflate}->{$name};
29}
30
31sub get_deflate {
32    my($class, $name) = @_;
33    $INFLATE{deflate}->{$name};
34}
35
36sub inflate_type {
37    my($name, $hash) = @_;
38    my $caller = caller;
39    for my $type (qw/ inflate deflate /) {
40        if (ref($hash->{$type}) eq 'CODE') {
41            Carp::croak "The inflate_type '$name' has already been created, cannot be created again in $caller"
42                    if $INFLATE{$type}->{$name};
43            $INFLATE{$type}->{$name} = $hash->{$type};
44        }
45    }
46}
47
481;
Note: See TracBrowser for help on using the browser.