| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package OMA::Download::DRM::REL::WBXML; | 
| 2 | 1 |  |  | 1 |  | 7 | use strict; | 
|  | 1 |  |  |  |  | 10 |  | 
|  | 1 |  |  |  |  | 48 |  | 
| 3 |  |  |  |  |  |  | BEGIN { | 
| 4 | 1 |  |  | 1 |  | 6 | use OMA::Download::DRM::REL; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 28 |  | 
| 5 | 1 |  |  | 1 |  | 597 | push @OMA::Download::DRM::REL::WBXML::ISA, 'OMA::Download::DRM::REL'; | 
| 6 |  |  |  |  |  |  | } | 
| 7 |  |  |  |  |  |  | =head1 NAME | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | OMA::Download::DRM::REL::WBXML - WBXML representation of OMA DRM REL 1.0 | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | WBXML representation of the Open Mobile Alliance Digital Rights Management Rights Expression Language 1.0. Used e.g. with Wap Push. | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | use OMA::Download::DRM::REL::WBXML; | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | =head1 CONSTRUCTOR | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | my $rel=OMA::Download::DRM::REL::WBXML->new(%args); | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | =head1 PROPERTIES | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | =head2 mime | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | Returns the WBXML rights object MIME type | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | print $rel->mime; | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | =cut | 
| 32 | 1 |  |  | 1 | 1 | 4 | sub mime      { 'application/vnd.oma.drm.rights+wbxml' } | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | =head2 extension | 
| 35 |  |  |  |  |  |  |  | 
| 36 |  |  |  |  |  |  | Returns the WBXML rights object extension | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | print $rel->extension; | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | =cut | 
| 41 | 0 |  |  | 0 | 1 | 0 | sub extension { '.drc' } | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | =head1 METHODS | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | =head2 packit | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | Packs data using WBXML format | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | print $rel->packit; | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | =cut | 
| 53 |  |  |  |  |  |  | sub packit { | 
| 54 | 1 |  |  | 1 | 1 | 2 | my ($self)=@_; | 
| 55 | 1 |  |  |  |  | 2 | my $res=''; | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | # header | 
| 58 | 1 |  |  |  |  | 13 | $res.=pack("C", 3);                               # WBXML Version Number (1.3) | 
| 59 | 1 |  |  |  |  | 2 | $res.=pack("C", 0x0e);                            # Public Identifier (~//OMA//DTD REL 1.0//EN) | 
| 60 | 1 |  |  |  |  | 2 | $res.=pack("C", 0x6a);                            # UTF-8 | 
| 61 | 1 |  |  |  |  | 2 | $res.=pack("C", 0x00);                            # String Table Length (empty) | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  | # rights element attributes | 
| 64 | 1 |  |  |  |  | 2 | my $rattr=''; | 
| 65 |  |  |  |  |  |  | #$rattr.=pack("C", 0xC5); # | 
| 66 | 1 |  |  |  |  | 2 | $rattr.=pack("C", 0x05); # xmlns:o-ex= | 
| 67 | 1 |  |  |  |  | 2 | $rattr.=pack("C", 0x85); # "http://odrl.net/1.1/ODRL-EX" | 
| 68 | 1 |  |  |  |  | 2 | $rattr.=pack("C", 0x06); # xmlns:o-dd= | 
| 69 | 1 |  |  |  |  | 2 | $rattr.=pack("C", 0x86); # "http://odrl.net/1.1/ODRL-DD" | 
| 70 | 1 |  |  |  |  | 1 | $rattr.=pack("C", 0x07); # xmlns:o-ds= | 
| 71 | 1 |  |  |  |  | 7 | $rattr.=pack("C", 0x87); # "http://www.w3.org/2000/09/xmldsig#/" | 
| 72 | 1 |  |  |  |  | 2 | $rattr.=pack("C", 0x01); # > | 
| 73 |  |  |  |  |  |  |  | 
| 74 | 1 |  |  |  |  | 8 | return $res.$self->_in_element('rights', $rattr.$self->_packin, 1); | 
| 75 |  |  |  |  |  |  | } | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | #--- Support routines ---------------------------------------------------------- | 
| 78 |  |  |  |  |  |  | sub _init { | 
| 79 | 1 |  |  | 1 |  | 3 | my $self=shift; | 
| 80 |  |  |  |  |  |  | #    $self->{element_tokens} = { | 
| 81 |  |  |  |  |  |  | #            rights      => 0xc5, | 
| 82 |  |  |  |  |  |  | #            context     => 0x46, | 
| 83 |  |  |  |  |  |  | #            version     => 0x47, | 
| 84 |  |  |  |  |  |  | #            uid         => 0x48, | 
| 85 |  |  |  |  |  |  | #            agreement   => 0x49, | 
| 86 |  |  |  |  |  |  | #            asset       => 0x4a, | 
| 87 |  |  |  |  |  |  | #            KeyInfo     => 0x4b, | 
| 88 |  |  |  |  |  |  | #            KeyValue    => 0x4c, | 
| 89 |  |  |  |  |  |  | #            permission  => 0x4d, | 
| 90 |  |  |  |  |  |  | #            play        => 0x4e, | 
| 91 |  |  |  |  |  |  | #            display     => 0x4f, | 
| 92 |  |  |  |  |  |  | #            execute     => 0x50, | 
| 93 |  |  |  |  |  |  | #            print       => 0x51, | 
| 94 |  |  |  |  |  |  | #            constraint  => 0x52, | 
| 95 |  |  |  |  |  |  | #            count       => 0x53, | 
| 96 |  |  |  |  |  |  | #            datetime    => 0x54, | 
| 97 |  |  |  |  |  |  | #            start       => 0x55, | 
| 98 |  |  |  |  |  |  | #            end         => 0x56, | 
| 99 |  |  |  |  |  |  | #            interval    => 0x57, | 
| 100 |  |  |  |  |  |  | #    }; | 
| 101 | 1 |  |  |  |  | 28 | $self->{element_tokens} = { | 
| 102 |  |  |  |  |  |  | rights      => 0x05, | 
| 103 |  |  |  |  |  |  | context     => 0x06, | 
| 104 |  |  |  |  |  |  | version     => 0x07, | 
| 105 |  |  |  |  |  |  | uid         => 0x08, | 
| 106 |  |  |  |  |  |  | agreement   => 0x09, | 
| 107 |  |  |  |  |  |  | asset       => 0x0a, | 
| 108 |  |  |  |  |  |  | KeyInfo     => 0x0b, | 
| 109 |  |  |  |  |  |  | KeyValue    => 0x0c, | 
| 110 |  |  |  |  |  |  | permission  => 0x0d, | 
| 111 |  |  |  |  |  |  | play        => 0x0e, | 
| 112 |  |  |  |  |  |  | display     => 0x0f, | 
| 113 |  |  |  |  |  |  | execute     => 0x10, | 
| 114 |  |  |  |  |  |  | print       => 0x11, | 
| 115 |  |  |  |  |  |  | constraint  => 0x12, | 
| 116 |  |  |  |  |  |  | count       => 0x13, | 
| 117 |  |  |  |  |  |  | datetime    => 0x14, | 
| 118 |  |  |  |  |  |  | start       => 0x15, | 
| 119 |  |  |  |  |  |  | end         => 0x16, | 
| 120 |  |  |  |  |  |  | interval    => 0x17, | 
| 121 |  |  |  |  |  |  | }; | 
| 122 | 1 |  |  |  |  | 4 | return 1; | 
| 123 |  |  |  |  |  |  | } | 
| 124 |  |  |  |  |  |  | sub _in_element { | 
| 125 | 13 |  |  | 13 |  | 23 | my ($self, $element, $content, $is_root)=@_; | 
| 126 | 13 | 50 |  |  |  | 35 | die "Unknown element token $element" unless $self->{element_tokens}{$element}; | 
| 127 |  |  |  |  |  |  | # 01 is | 
| 128 | 13 |  |  |  |  | 16 | my $term=''; | 
| 129 | 13 |  |  |  |  | 19 | my $token=$self->{element_tokens}{$element}; | 
| 130 | 13 | 50 |  |  |  | 26 | if ($content) { | 
| 131 | 13 |  |  |  |  | 15 | $token|=0x40; | 
| 132 | 13 |  |  |  |  | 15 | $term=pack("C", 01); | 
| 133 |  |  |  |  |  |  | } | 
| 134 | 13 | 100 |  |  |  | 25 | if ($is_root) { | 
| 135 | 1 |  |  |  |  | 2 | $token|=0x80; | 
| 136 |  |  |  |  |  |  | } | 
| 137 | 13 |  |  |  |  | 79 | return pack("C", $token).$content.$term; | 
| 138 |  |  |  |  |  |  | } | 
| 139 |  |  |  |  |  |  | sub _in_string { | 
| 140 | 3 |  |  | 3 |  | 7 | my($self,$string)=@_; | 
| 141 |  |  |  |  |  |  | # 03 means "Inline String Follows" | 
| 142 |  |  |  |  |  |  | # 00 means "End of String" | 
| 143 | 3 |  |  |  |  | 12 | return pack("C", 03).$string.pack("C", 00); | 
| 144 |  |  |  |  |  |  | } | 
| 145 |  |  |  |  |  |  | sub _in_opaque { | 
| 146 | 1 |  |  | 1 |  | 2 | my($self,$data)=@_; | 
| 147 | 1 |  |  |  |  | 7 | return pack("C", 0xc3).pack("C", length($data)).$data; | 
| 148 |  |  |  |  |  |  | } | 
| 149 |  |  |  |  |  |  | 1; | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | __END__ |