File Coverage

lib/OMA/Download/DRM/REL/WBXML.pm
Criterion Covered Total %
statement 40 41 97.5
branch 4 6 66.6
condition n/a
subroutine 9 10 90.0
pod 3 3 100.0
total 56 60 93.3


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__