|
1 # Copyright (c) 2004-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
2 # All rights reserved. |
|
3 # This component and the accompanying materials are made available |
|
4 # under the terms of "Eclipse Public License v1.0" |
|
5 # which accompanies this distribution, and is available |
|
6 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
7 # |
|
8 # Initial Contributors: |
|
9 # Nokia Corporation - initial contribution. |
|
10 # |
|
11 # Contributors: |
|
12 # |
|
13 # Description: |
|
14 # |
|
15 |
|
16 #!/usr/bin/perl |
|
17 |
|
18 # xml2wap.pl |
|
19 # This script takes an XML file and creates a WAP Binary encoded file from it. |
|
20 # The constants derfined here are for the WAP Provisioning messages - to handle a different DTD |
|
21 # you should just be able to change the constants (but I haven't tested that). |
|
22 # Ian McDowall December 2001 |
|
23 |
|
24 use strict; |
|
25 |
|
26 $Main::DebugLevel = 2; # Set higher for more debug or lower for less. |
|
27 |
|
28 # Global variables used to set standard header values - modify these here |
|
29 $Main::XMLVersion = 0x01 ; # 0x01 = v1.1 |
|
30 $Main::PublicId = 0x01 ; # Magic number taken from OTA doc |
|
31 $Main::Charset = 106 ; # Magic number from OTA |
|
32 |
|
33 $Main::EndToken = 1 ; #Magic number from OTA |
|
34 $Main::InLineString = 3 ; # Magic number from OTA |
|
35 |
|
36 # Hash containing defined tag tokens |
|
37 %Main::TagTokens = ( |
|
38 "CHARACTERISTIC-LIST", 0x05, |
|
39 "CHARACTERISTIC", 0x06, |
|
40 "PARM", 0x07); |
|
41 |
|
42 # Hash containing defined attribute name-value pairs. |
|
43 # Ones which do not appear here are handled as inline strings |
|
44 %Main::AttributePairs = ( |
|
45 "TYPE=ADDRESS", 0x06, |
|
46 "TYPE=URL", 0x07, |
|
47 "TYPE=NAME", 0x08, |
|
48 "TYPE=MMSURL", 0x7c, |
|
49 "NAME=BEARER", 0x12, |
|
50 "NAME=PROXY", 0x13, |
|
51 "NAME=PORT", 0x14, |
|
52 "NAME=NAME", 0x15, |
|
53 "NAME=PROXY_TYPE", 0x16, |
|
54 "NAME=URL", 0x17, |
|
55 "NAME=PROXY_AUTHNAME", 0x18, |
|
56 "NAME=PROXY_AUTHSECRET", 0x19, |
|
57 "NAME=SMS_SMSC_ADDRESS", 0x1A, |
|
58 "NAME=USSD_SERVICE_CODE", 0x1B, |
|
59 "NAME=GPRS_ACCESSPOINTNAME", 0x1C, |
|
60 "NAME=PPP_LOGINTYPE", 0x1D, |
|
61 "NAME=PROXY_LOGINTYPE", 0x1E, |
|
62 "NAME=CSD_DIALSTRING", 0x21, |
|
63 "NAME=CSD_CALLTYPE", 0x28, |
|
64 "NAME=CSD_CALLSPEED", 0x29, |
|
65 "NAME=PPP_AUTHTYPE", 0x22, |
|
66 "NAME=PPP_AUTHNAME", 0x23, |
|
67 "NAME=PPP_AUTHSECRET", 0x24, |
|
68 "VALUE=GSM/CSD", 0x45, |
|
69 "VALUE=GSM/SMS", 0x46, |
|
70 "VALUE=GSM/USSD", 0x47, |
|
71 "VALUE=IS-136/CSD", 0x48, |
|
72 "VALUE=GPRS", 0x49, |
|
73 "VALUE=9200", 0x60, |
|
74 "VALUE=9201", 0x61, |
|
75 "VALUE=9202", 0x62, |
|
76 "VALUE=9203", 0x63, |
|
77 "VALUE=AUTOMATIC", 0x64, |
|
78 "VALUE=MANUAL", 0x65, |
|
79 "VALUE=AUTO", 0x6a, |
|
80 "VALUE=9600", 0x6b, |
|
81 "VALUE=14400", 0x6c, |
|
82 "VALUE=19200", 0x6d, |
|
83 "VALUE=28800", 0x6e, |
|
84 "VALUE=38400", 0x6f, |
|
85 "VALUE=PAP", 0x70, |
|
86 "VALUE=CHAP", 0x71, |
|
87 "VALUE=ANALOGUE", 0x72, |
|
88 "VALUE=ISDN", 0x73, |
|
89 "VALUE=43200", 0x74, |
|
90 "VALUE=57600", 0x75, |
|
91 "VALUE=MSISDN_NO", 0x76, |
|
92 "VALUE=IPV4", 0x77, |
|
93 "VALUE=MS_CHAP", 0x78, |
|
94 "TYPE=MMSURL", 0x7c, |
|
95 "TYPE=ID", 0x7d, |
|
96 "NAME=ISP_NAME", 0x7e, |
|
97 "TYPE=BOOKMARK", 0x7f |
|
98 ); |
|
99 |
|
100 # Hash containing defined attribute names which get linked to inline strings |
|
101 %Main::AttributeSingles = ( |
|
102 "NAME", 0x10, |
|
103 "VALUE", 0x11); |
|
104 |
|
105 # Global Variables used for data storage :-( |
|
106 $Main::ReadBuffer = ''; # Buffer holds a line at a time as read in |
|
107 $Main::InFileComplete = 0; # Boolean - have we finished reading the input file |
|
108 $Main::ReadAllTokens = 0; # Boolean - have we read all tokens yet |
|
109 |
|
110 # Global variables used for pending writes. |
|
111 # The octet used for a tag has the top two bits set depending on whether or |
|
112 # it includes content (i.e. other elements) and / or attributes. |
|
113 # We don't know whether or not it includes these until we hit another tag or an |
|
114 # end tag. Therefore, we build up a string of pending attribute data and have a |
|
115 # pending tag identifier. We never need more than one. |
|
116 $Main::PendingTag = 0; |
|
117 $Main::PendingAttribs = 0; |
|
118 $Main::TagHasContent = 0; |
|
119 $Main::TagHasAttribs = 0; |
|
120 |
|
121 ############################################################################### |
|
122 # Main entry point |
|
123 |
|
124 if(!$ARGV[0] || !$ARGV[1]) |
|
125 { |
|
126 &OutputHelp(); |
|
127 } |
|
128 else |
|
129 { |
|
130 my($InFileName, $OutFileName);# Input and output file names |
|
131 $InFileName = $ARGV[0]; |
|
132 $OutFileName = $ARGV[1]; |
|
133 |
|
134 # Open the XML file |
|
135 open( INFILE, $InFileName ) or die("Unable to open $InFileName for reading"); |
|
136 print "Reading $InFileName\n"; |
|
137 |
|
138 # Open the output file and create the binary encoded version of the XML |
|
139 open( OUTFILE, ">$OutFileName" ) or die("Unable to open $OutFileName for writing"); |
|
140 print "Creating $OutFileName\n"; |
|
141 |
|
142 &ParseXMLFile(); |
|
143 |
|
144 close( INFILE ); |
|
145 close( OUTFILE ); |
|
146 print "Processing complete\n"; |
|
147 } |
|
148 |
|
149 |
|
150 ############################################################################### |
|
151 # Describe required arguments |
|
152 sub OutputHelp |
|
153 { |
|
154 print "This script requires two arguments. The first is the name of an XML file\n"; |
|
155 print "to be taken as input. The second is the name of a WAP encoded binary XML\n"; |
|
156 print "to be created.\n"; |
|
157 } |
|
158 |
|
159 ############################################################################### |
|
160 # Routine to read and parse an input XML file |
|
161 sub ParseXMLFile |
|
162 { |
|
163 # Output the version, publicid and charset |
|
164 &OutputStandardHeader(); |
|
165 |
|
166 my $Token = &ReadToken(); |
|
167 while(!$Main::ReadAllTokens) |
|
168 { |
|
169 # Behaviour depends on the token type |
|
170 if($Token eq '<?xml') |
|
171 {# Ignore version and skip |
|
172 &DebugPrint(2,"Skipping XML version\n"); |
|
173 &SkipTill('?>'); |
|
174 } |
|
175 elsif($Token eq '<!DOCTYPE') |
|
176 {# Ignore DTD and skip |
|
177 &DebugPrint(2,"Skipping DTD\n"); |
|
178 &SkipTill(']>'); |
|
179 } |
|
180 elsif(substr($Token,0,1) eq '<') |
|
181 {# Element - process it |
|
182 &ParseElement($Token); |
|
183 } |
|
184 $Token = &ReadToken(); |
|
185 } |
|
186 } |
|
187 |
|
188 ############################################################################### |
|
189 # Routine to parse an element |
|
190 sub ParseElement |
|
191 { |
|
192 my $ElementName = shift(@_); |
|
193 $ElementName = substr($ElementName,1); #trim leading '<' |
|
194 if(substr($ElementName,0,1) eq '/') |
|
195 {# closing tag |
|
196 chop($ElementName); |
|
197 &DebugPrint(2,"Parsing end of element $ElementName\n"); |
|
198 |
|
199 # Flush any pending tag |
|
200 if($Main::PendingTag != 0) |
|
201 { |
|
202 &OutputPendingTag(); |
|
203 } |
|
204 |
|
205 # Output an end token, regardless of what closing tag we have |
|
206 &OutputOctet($Main::EndToken); |
|
207 } |
|
208 else |
|
209 { |
|
210 my $HasAttribs = 1; |
|
211 if(substr($ElementName,-1) eq '>') |
|
212 { |
|
213 $HasAttribs = 0; |
|
214 chop($ElementName); |
|
215 } |
|
216 my $HasContent = 1; |
|
217 if(substr($ElementName,-1) eq '/') |
|
218 { |
|
219 $HasContent = 0; |
|
220 chop($ElementName); |
|
221 } |
|
222 &DebugPrint(2,"Parsing element $ElementName\n"); |
|
223 |
|
224 # Flush any pending tag |
|
225 if($Main::PendingTag != 0) |
|
226 { |
|
227 &OutputPendingTag(); |
|
228 } |
|
229 |
|
230 # We have a new tag - make it pending |
|
231 $Main::PendingTag = $Main::TagTokens{$ElementName}; |
|
232 if(!$Main::PendingTag) |
|
233 { |
|
234 print "Unrecognised tag $ElementName\n"; |
|
235 } |
|
236 splice(@Main::PendingAttribs,0); #empty pending attribs array |
|
237 |
|
238 if($HasAttribs) |
|
239 { |
|
240 my $AttToken = &ReadToken(); |
|
241 while(substr($AttToken,-1) ne '>') # sloppy I know |
|
242 { |
|
243 my $EqToken = &ReadToken(); # we could check this |
|
244 my $ValToken = &ReadToken(); |
|
245 &PushAttribute($AttToken, $ValToken); |
|
246 &DebugPrint(2,"Attribute $AttToken = $ValToken\n"); |
|
247 $AttToken = &ReadToken(); |
|
248 } |
|
249 if(substr($AttToken,-2) eq '/>') |
|
250 { |
|
251 $HasContent = 0; |
|
252 } |
|
253 } |
|
254 |
|
255 # If we had any attributes then flag this |
|
256 if(@Main::PendingAttribs > 0) |
|
257 { |
|
258 $Main::TagHasAttributes = 1; |
|
259 } |
|
260 $Main::TagHasContent = $HasContent; |
|
261 |
|
262 # Flush any pending tag |
|
263 if($Main::PendingTag != 0) |
|
264 { |
|
265 &OutputPendingTag(); |
|
266 } |
|
267 |
|
268 } |
|
269 } |
|
270 |
|
271 ############################################################################### |
|
272 # Routine to skip until it matches a token (eating the matched token) |
|
273 sub SkipTill |
|
274 { |
|
275 my $SkipToken = shift(@_); |
|
276 my $Token = &ReadToken(); |
|
277 while(!$Main::ReadAllTokens && ($Token ne $SkipToken)) |
|
278 { |
|
279 $Token = &ReadToken(); |
|
280 } |
|
281 &DebugPrint(3,"Skipped till $SkipToken\n"); |
|
282 } |
|
283 |
|
284 ############################################################################### |
|
285 # Routine to read the next token from the input file |
|
286 # A token is delineated by whitespace (so it won't work too well with strings with |
|
287 # embedded newlines) or quotes |
|
288 sub ReadToken |
|
289 { |
|
290 my($FoundToken); |
|
291 $FoundToken = ''; |
|
292 |
|
293 if(!$Main::ReadAllTokens) |
|
294 { |
|
295 &RefreshInputBuffer; |
|
296 if(@Main::ReadTokens > 0) |
|
297 { |
|
298 $FoundToken = shift(@Main::ReadTokens); |
|
299 } |
|
300 while(length($FoundToken) <= 0) |
|
301 { |
|
302 if((@Main::ReadTokens <= 0) && $Main::InFileComplete) |
|
303 { |
|
304 $Main::ReadAllTokens = 1; |
|
305 last; |
|
306 } |
|
307 &RefreshInputBuffer; |
|
308 if(@Main::ReadTokens > 0) |
|
309 { |
|
310 $FoundToken = shift(@Main::ReadTokens); |
|
311 } |
|
312 } |
|
313 } |
|
314 |
|
315 &DebugPrint(4,"Token :$FoundToken:\n"); |
|
316 return $FoundToken; |
|
317 } |
|
318 |
|
319 ############################################################################### |
|
320 # Routine to refresh the input buffer |
|
321 sub RefreshInputBuffer |
|
322 { |
|
323 while((@Main::ReadTokens <= 0) && !$Main::InFileComplete) |
|
324 { |
|
325 $Main::ReadBuffer = <INFILE>; |
|
326 &DebugPrint(5, $Main::ReadBuffer); |
|
327 |
|
328 if(length($Main::ReadBuffer) <= 0) |
|
329 { |
|
330 $Main::InFileComplete = 1; |
|
331 &DebugPrint(4,"Input file exhausted\n"); |
|
332 } |
|
333 else |
|
334 { |
|
335 # Remove leading and trailing whitespace |
|
336 $Main::ReadBuffer =~ s/^\s+//; |
|
337 $Main::ReadBuffer =~ s/\s+$//; |
|
338 # Split into an array of tokens on whitespace and quotes and equals - lose the quotes on the way |
|
339 my ($OneToken, $OneChar); |
|
340 while(length($Main::ReadBuffer) > 0) |
|
341 { |
|
342 $OneChar = substr($Main::ReadBuffer,0,1); |
|
343 $Main::ReadBuffer = substr($Main::ReadBuffer,1); |
|
344 if(($OneChar eq ' ') || ($OneChar eq "\t")) |
|
345 { # whitespace is separator outside quotes |
|
346 &DebugPrint(6,"Whitespace\n"); |
|
347 if(length($OneToken) > 0) |
|
348 { |
|
349 push(@Main::ReadTokens, $OneToken); |
|
350 $OneToken = ''; |
|
351 } |
|
352 } |
|
353 elsif($OneChar eq '"') |
|
354 { # copy to next quote, including whitespace |
|
355 &DebugPrint(6,"Start of quotes\n"); |
|
356 if(length($OneToken) > 0) |
|
357 { |
|
358 push(@Main::ReadTokens, $OneToken); |
|
359 $OneToken = ''; |
|
360 } |
|
361 $OneChar = ''; |
|
362 until(($OneChar eq '"') || (length($Main::ReadBuffer) <= 0)) |
|
363 { |
|
364 $OneToken = $OneToken.$OneChar; |
|
365 $OneChar = substr($Main::ReadBuffer,0,1); |
|
366 $Main::ReadBuffer = substr($Main::ReadBuffer,1); |
|
367 } |
|
368 &DebugPrint(6,"quoted string '$OneToken'\n"); |
|
369 push(@Main::ReadTokens, $OneToken); |
|
370 $OneToken = ''; |
|
371 } |
|
372 elsif($OneChar eq '=') |
|
373 { # = is separate token |
|
374 &DebugPrint(6,"char =\n"); |
|
375 if(length($OneToken) > 0) |
|
376 { |
|
377 push(@Main::ReadTokens, $OneToken); |
|
378 $OneToken = ''; |
|
379 } |
|
380 push(@Main::ReadTokens,'='); |
|
381 } |
|
382 else |
|
383 { # routine char - append to building token |
|
384 &DebugPrint(6,"Char $OneChar\n"); |
|
385 $OneToken = $OneToken.$OneChar; |
|
386 } |
|
387 }#endwhile |
|
388 #last token on the line |
|
389 if(length($OneToken) > 0) |
|
390 { |
|
391 push(@Main::ReadTokens, $OneToken); |
|
392 $OneToken = ''; |
|
393 } |
|
394 |
|
395 &DebugPrint(5,join( ':', @Main::ReadTokens)."\n"); |
|
396 } |
|
397 } |
|
398 } |
|
399 |
|
400 ############################################################################### |
|
401 # Routine to output a standard set of header fields |
|
402 # These are all set by globals at the head of the script (for ease of modification) |
|
403 sub OutputStandardHeader() |
|
404 { |
|
405 # Output the XML version |
|
406 &OutputOctet($Main::XMLVersion); |
|
407 |
|
408 # Output a standard public Id |
|
409 &Output_mb_u_int32($Main::PublicId); |
|
410 |
|
411 # Output charset |
|
412 &Output_mb_u_int32($Main::Charset); |
|
413 |
|
414 # Output a zero-length string table |
|
415 &OutputOctet(0); |
|
416 |
|
417 } |
|
418 |
|
419 ############################################################################### |
|
420 # Routine to push an attribute name, value pair in one of a number of ways |
|
421 sub PushAttribute() |
|
422 { |
|
423 my $AttName = shift(@_); |
|
424 my $AttVal = shift(@_); |
|
425 |
|
426 my $PairToken = $Main::AttributePairs{$AttName.'='.$AttVal}; |
|
427 if($PairToken) |
|
428 { |
|
429 push(@Main::PendingAttribs,$PairToken); |
|
430 } |
|
431 else |
|
432 { |
|
433 my $AttribToken = $Main::AttributeSingles{$AttName}; |
|
434 if($AttribToken) |
|
435 { |
|
436 push(@Main::PendingAttribs,$AttribToken); |
|
437 &PushInLineString($AttVal); |
|
438 print "Attribute $AttName has string (rather than token) value $AttVal\n"; |
|
439 } |
|
440 else |
|
441 { |
|
442 print "Unrecognised attribute $AttName\n"; |
|
443 } |
|
444 } |
|
445 } |
|
446 |
|
447 ############################################################################### |
|
448 # Routine to flush a pending tag and any attributes |
|
449 # |
|
450 sub OutputPendingTag() |
|
451 { |
|
452 &DebugPrint(3,"Output pending tag $Main::PendingTag\n"); |
|
453 my $TagOctet = $Main::PendingTag; |
|
454 if( $Main::TagHasContent) |
|
455 { |
|
456 $TagOctet = $TagOctet | 0x40 ; # Set next-to-top bit for has content |
|
457 } |
|
458 if( $Main::TagHasAttributes) |
|
459 { |
|
460 $TagOctet = $TagOctet | 0x80 ; # Set top bit for has attributes |
|
461 } |
|
462 &OutputOctet($TagOctet); |
|
463 |
|
464 if($Main::TagHasAttributes) |
|
465 { |
|
466 &OutputOctetArray(@Main::PendingAttribs); |
|
467 &OutputOctet($Main::EndToken); # END after attributes |
|
468 } |
|
469 else |
|
470 { |
|
471 &DebugPrint(3,"Tag has no attributes\n"); |
|
472 } |
|
473 |
|
474 # Clean out pending |
|
475 $Main::PendingTag = 0; |
|
476 splice(@Main::PendingAttribs,0); #empty pending attribs array |
|
477 } |
|
478 |
|
479 ############################################################################### |
|
480 # Routine to output a mb_u_int32 value - up to 32 bits but divided into 7-bit |
|
481 # chunks and the top bit is set for continuation |
|
482 sub Output_mb_u_int32() |
|
483 { |
|
484 my $InNum = shift(@_); |
|
485 |
|
486 my @OutBytes; |
|
487 my $ByteCount = 0; |
|
488 while( $ByteCount < 5 ) # magic number - maximum number of octets output |
|
489 { |
|
490 my $OctetValue = $InNum & 0x7f; |
|
491 if($OctetValue > 0) |
|
492 { |
|
493 push(@OutBytes, $OctetValue); |
|
494 $InNum = $InNum >> 7; |
|
495 $ByteCount ++; |
|
496 } |
|
497 else |
|
498 { |
|
499 last; |
|
500 } |
|
501 } |
|
502 |
|
503 if($ByteCount > 0) |
|
504 { |
|
505 while($ByteCount > 0) |
|
506 { |
|
507 if($ByteCount == 1) |
|
508 { # Output last byte without continuation bit |
|
509 &OutputOctet($OutBytes[$ByteCount-1]); |
|
510 } |
|
511 else |
|
512 { # Output byte with continuation bit |
|
513 &OutputOctet($OutBytes[$ByteCount-1]|0x80); |
|
514 } |
|
515 $ByteCount --; |
|
516 } |
|
517 } |
|
518 else # zero - just output a zero byte |
|
519 { |
|
520 &OutputOctet(0); |
|
521 } |
|
522 } |
|
523 |
|
524 ############################################################################### |
|
525 # Output a single octet |
|
526 sub OutputOctet |
|
527 { |
|
528 my $OctetValue = shift(@_); |
|
529 print OUTFILE chr($OctetValue); |
|
530 &DebugPrint(3, sprintf(":%lx:", $OctetValue)); |
|
531 } |
|
532 |
|
533 ############################################################################### |
|
534 # Add an inline string to the pending attributes buffer |
|
535 sub PushInLineString |
|
536 { |
|
537 my $InString = shift(@_); |
|
538 push(@Main::PendingAttribs, $Main::InLineString); |
|
539 my $Index; |
|
540 for( $Index = 0 ; $Index < length($InString) ; $Index ++) |
|
541 { |
|
542 push(@Main::PendingAttribs, ord(substr($InString,$Index,1))); |
|
543 } |
|
544 push(@Main::PendingAttribs, 0); # terminating null |
|
545 } |
|
546 |
|
547 ############################################################################### |
|
548 # Output an array of octet values |
|
549 sub OutputOctetArray |
|
550 { |
|
551 while(@_ > 0) |
|
552 { |
|
553 my $OctetValue = shift(@_); |
|
554 &OutputOctet($OctetValue); |
|
555 } |
|
556 } |
|
557 |
|
558 ############################################################################### |
|
559 # Debug print routine - takes a level of detail and a string and conditionally |
|
560 # prints the string |
|
561 sub DebugPrint() |
|
562 { |
|
563 my $DebugLevel = shift(@_); |
|
564 my $DebugString = shift(@_); |
|
565 if( $DebugLevel <= $Main::DebugLevel ) |
|
566 { |
|
567 print $DebugString; |
|
568 } |
|
569 } |
|
570 |
|
571 ###### End of File ###### |
|
572 |