CGI-WML
view release on metacpan or search on metacpan
@ISA = qw(Exporter CGI CGI::Util); # Inherit from CGI.pm
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw();
$VERSION = "0.09";
$RCSVERSION = do{my@r=q$Revision: 1.67 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r};
my $DEFAULT_DTD = '-//WAPFORUM//DTD WML 1.1//EN';
my $DEFAULT_DTD_URL = 'http://www.wapforum.org/DTD/wml_1.1.xml';
my $DOTABLE = 1; # Whether to use string tables.
my ($WBML_RETBUFF,%TEMP_STRTAB,%STRTAB);
# Wireless Binary Markup Language, as defined in WAP forum docs
my $WBML_INLINE_STRING = 0x03;
my $WBML_INLINE_STRING_END = 0x00;
my $WBML_STRINGTABLE_REF = 0x83;
my $WMLTC_ATTRIBUTES = 0x80;
my $WMLTC_CONTENT = 0x40;
my $WMLTC_END = 0x01;
%WBML_TAGS = ( # dec # hex
'pre' => '27', # 0x1B
'a' => '28', # 0x1C
'td' => '29', # 0x1D
'tr' => '30', # 0x1E
'Tr' => '30', # 0x1E
'table' => '31', # 0x1F
'p' => '32', # 0x20
'postfield' => '33', # 0x21
'anchor' => '34', # 0x22
'access' => '35', # 0x23
'b' => '36', # 0x24
'big' => '37', # 0x25
'br' => '38', # 0x26
'card' => '39', # 0x27
'do' => '40', # 0x28
'em' => '41', # 0x29
'fieldset' => '42', # 0x2A
'go' => '43', # 0x2B
'head' => '44', # 0x2C
'i' => '45', # 0x2D
'img' => '46', # 0x2E
'input' => '47', # 0x2F
'meta' => '48', # 0x30
'noop' => '49', # 0x31
'prev' => '50', # 0x32
'onevent' => '51', # 0x33
'optgroup' => '52', # 0x34
'option' => '53', # 0x35
'refresh' => '54', # 0x36
'select' => '55', # 0x37
'small' => '56', # 0x38
'strong' => '57', # 0x39
'UNUSED' => '58', # 0x3A
'template' => '59', # 0x3B
'timer' => '60', # 0x3C
'u' => '61', # 0x3D
'setvar' => '62', # 0x3E
'wml' => '63', # 0x3F
);
%WBML_ATTRS = ( # dec # hex
'accept-charset' => '05', # 0x05
'align="bottom"' => '06', # 0x06
'align="center"' => '07', # 0x07
'align="left"' => '08', # 0x08
'align="middle"' => '09', # 0x09
'align="right"' => '10', # 0x0A
'align="top"' => '11', # 0x0B
'alt' => '12', # 0x0C
'content' => '13', # 0x0D
'NULL,' => '14', # 0x0E
'domain' => '15', # 0x0F
'emptyok="false"' => '16', # 0x10
'emptyok="true"' => '17', # 0x11
'format' => '18', # 0x12
'height' => '19', # 0x13
'hspace' => '20', # 0x14
'ivalue' => '21', # 0x15
'iname' => '22', # 0x16
'NULL,' => '23', # 0x17
'label' => '24', # 0x18
'localsrc' => '25', # 0x19
'maxlength' => '26', # 0x1A
'method="get"' => '27', # 0x1B
'method="post"' => '28', # 0x1C
'mode="nowrap"' => '29', # 0x1D
'mode="wrap"' => '30', # 0x1E
'multiple="false"' => '31', # 0x1F
'multiple="true"' => '32', # 0x20
'name' => '33', # 0x21
'newcontext="false"' => '34', # 0x22
'newcontext="true"' => '35', # 0x23
'onpick' => '36', # 0x24
'onenterbackward' => '37', # 0x25
'onenterforward' => '38', # 0x26
'ontimer' => '39', # 0x27
'optional="false"' => '40', # 0x28
'optional="true"' => '41', # 0x29
'path' => '42', # 0x2A
'NULL,' => '43', # 0x2B
'NULL,' => '44', # 0x2C
'NULL,' => '45', # 0x2D
'scheme' => '46', # 0x2E
'sendreferer="false"' => '47', # 0x2F
'sendreferer="true"' => '48', # 0x30
'size' => '49', # 0x31
'src' => '50', # 0x32
'ordered="true"' => '51', # 0x33
'ordered="false"' => '52', # 0x34
'tabindex' => '53', # 0x35
'title' => '54', # 0x36
'type' => '55', # 0x37
'type="accept"' => '56', # 0x38
'type="delete"' => '57', # 0x39
'type="help"' => '58', # 0x3A
'type="password"' => '59', # 0x3B
'type="onpick"' => '60', # 0x3C
'type="onenterbackward"' => '61', # 0x3D
'type="onenterforward"' => '62', # 0x3E
'type="ontimer"' => '63', # 0x3F
'NULL,' => '64', # 0x40
'NULL,' => '65', # 0x41
'NULL,' => '66', # 0x42
'NULL,' => '67', # 0x43
'NULL,' => '68', # 0x44
'NULL,' => '69', # 0x45
'type="prev"' => '70', # 0x46
'type="reset"' => '71', # 0x47
'type="text"' => '72', # 0x48
'type="vnd."' => '73', # 0x49
'href' => '74', # 0x4A
'href="http://' => '75', # 0x4B
'href="https://' => '76', # 0x4C
'value' => '77', # 0x4D
'vspace' => '78', # 0x4E
'width' => '79', # 0x4F
'xml:lang' => '80', # 0x50
'NULL,' => '81', # 0x51
'align' => '82', # 0x52
'columns' => '83', # 0x53
'class' => '84', # 0x54
'id' => '85', # 0x55
'forua="false"' => '86', # 0x56
'forua="true"' => '87', # 0x57
'src="http://' => '88', # 0x58
'src="https://' => '89', # 0x59
'http-equiv' => '90', # 0x5A
'http-equiv="Content-Type"' => '91', # 0x5B
'content="application/vnd.wap.wmlc;charset=' => '92', # 0x5C
'http-equiv="Expires"' => '93', # 0x5D
'accesskey' => '94', # 0x5E
'enctype' => '95', # 0x5F
'enctype="application/x-www-from-urlencoded"' => '96', # 0x60
'enctype="multipart/form-data"' => '97', # 0x61
);
%WBML_VALUES = ( # dec # hex
'.com/' => '133', # 0x85
'.edu/' => '134', # 0x86
'.net/' => '135', # 0x87
'.org/' => '136', # 0x88
'accept' => '137', # 0x89
'bottom' => '138', # 0x8A
'clear' => '139', # 0x8B
'delete' => '140', # 0x8C
'help' => '141', # 0x8D
'http://' => '142', # 0x8E
'http://www.' => '143', # 0x8F
'https://' => '144', # 0x90
'https://www.' => '145', # 0x91
'NULL' => '146', # 0x92
'middle' => '147', # 0x93
'nowrap' => '148', # 0x94
'onpick' => '149', # 0x95
'onenterbackward' => '150', # 0x96
'onenterforward' => '151', # 0x97
'ontimer' => '152', # 0x98
'options' => '153', # 0x99
'password' => '154', # 0x9A
'reset' => '155', # 0x9B
'NULL' => '156', # 0x9C
'text' => '157', # 0x9D
'top' => '158', # 0x9E
'unknown' => '159', # 0x9F
'wrap' => '160', # 0xA0
'www.' => '161'); # 0xA1
%WBML_NO_CLOSE_TAGS = (
'br' => '1',
'go' => '1',
'input' => '1',
'noop' => '1',
'prev' => '1',
'img' => '1',
'meta' => '1',
'timer' => '1',
'setvar' => '1');
# HTML->WML conversion constants
# Ignore these HTML and iMode tags completely.
my %IGNORE_TAG = map {$_ => 1} qw(abbr acronym address applet area basefont
bdo body cite col colgroup del dfn dir div
dl dt fieldsset font frame frameset head
html iframe legend link noframes noscript
object param script span style textarea
tfoot thead var);
# Straightforward one to one tag mapping
my %TAGMAP = map {$_ => 1} qw(em strong i b u big small pre tr td);
my (%Open_Tags,@Open_Tables,$Open_Form_Url,
@Open_Vars,%Hidden_Vars,$F_Got_Body_Tag);
###
## End of global variable setting.
###
### Method: header
# Override the CGI.pm header default with the WML one.
# Contributed by Wilbert Smits <wilbert@telegraafnet.nl>
###
sub header {
local($^W)=0;
my($self,@p) = &CGI::self_or_default(@_);
my($type, @leftover) = rearrange([TYPE],@p);
my %leftover;
foreach (@leftover) {
next unless my($header,$value) = /([^\s=]+)=\"?([^\"]+)\"?/;
$leftover{$header} = $value;
}
if(!defined $type) {$type = "text/vnd.wap.wml"}
return $self->SUPER::header("-type"=>$type, %leftover);
}
### Method: start_wml
# Guess what this does!
###
sub start_wml {
my($self,@p) = &CGI::self_or_default(@_);
my($meta,$dtd,$dtd_url,$lang,$encoding) =
rearrange([META,DTD,DTD_URL,LANG,ENCODING],@p);
if (!defined $encoding) { $encoding="iso-8859-1";}
my(@result);
push @result,qq(<?xml version="1.0" encoding="$encoding"?>);
$dtd = $DEFAULT_DTD unless $dtd && $dtd =~ m|^-//|;
$dtd_url = $DEFAULT_DTD_URL unless $dtd_url && $dtd_url =~ m|^http|;
push(@result,qq(\n<!DOCTYPE wml PUBLIC "$dtd"
"$dtd_url">\n)) if $dtd && $dtd_url;
push(@result,qq(<wml));
push(@result,qq(xml:lang="$lang")) if (defined $lang);
push(@result,">");
if (defined $meta) {
push(@result,"<head>");
if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
foreach (keys %$meta) {
push(@result,qq(<meta $_ $meta->{$_}/>\n));
}
}
push(@result,"</head>");
}
return join(" ",@result);
}
### Method: card
# make a complete WML card
####
sub card {
my ($self,@p) = &CGI::self_or_default(@_);
my ($id,$title,$content,$ontimer,$timer,$onenterforward,$onenterbackward,
$newcontext,$ordered,$class,$lang) =
rearrange([ID,TITLE,CONTENT,ONTIMER,TIMER,ONENTERFORWARD,ONENTERBACKWARD,NEWCONTEXT,ORDERED,CLASS,LANG],@p);
my @ret;
push(@ret,qq(\n<card id="$id"));
push(@ret,qq(title="$title")) if (defined $title);
push(@ret,qq(newcontext="$newcontext")) if (defined $newcontext);
push(@ret,qq(ontimer="$ontimer")) if (defined $ontimer);
push(@ret,qq(onenterforward="$onenterforward"))if(defined $onenterforward);
push(@ret,qq(onenterbackward="$onenterbackward"))if(defined $onenterbackward);
push(@ret,qq(xml:lang="$lang")) if (defined $lang);
push(@ret,qq(ordered="$ordered")) if (defined $ordered);
push(@ret,qq(class="$class")) if (defined $class);
push(@ret,qq(>));
push(@ret,qq($timer)) if (defined $timer);
push(@ret,qq( $content </card>)) if (defined $content);
return join (" ",@ret);
}
### Method: dialtag
# make a 'call this number' tag
####
sub dialtag {
my ($self,@p) = @_;
my ($number,$label) = rearrange([NUMBER,LABEL],@p);
$label = $number unless (defined $label);
my $ret = "<anchor>$label<go href='wtai://wp/mc/;$number'/></anchor>";
return $ret;
}
### Method: do
# make a 'do' tag
####
sub do {
# Oh no! Geoworks patent infringment ahead!
my ($self,@p) = @_;
my ($type,$class,$label,$name,$content,$optional) =
rearrange([TYPE,CLASS,LABEL,NAME,CONTENT,OPTIONAL],@p);
my @ret;
push(@ret,qq(<do type="$type"));
push(@ret,qq(optional="$optional")) if (defined $optional);
push(@ret,qq(name="$name")) if (defined $name);
push(@ret,qq(class="$class")) if (defined $class);
push(@ret,qq(label="$label")) if (defined $label);
push(@ret,qq(>$content</do>));
return join(" ",@ret);
}
### Method: template
# make a 'template' card for a deck
####
sub template {
my ($self,@p) = @_;
my ($content) = rearrange([CONTENT],@p);
my @ret;
push(@ret,qq(<template>$content</template>));
return join(" ",@ret);
}
### Method: go
# Make a 'go' block
###
sub go {
my ($self,@p) = @_;
my ($method,$href,$postfields) = rearrange([METHOD,HREF,POSTFIELDS],@p);
my @ret;
push(@ret,qq(<go href="$href"));
push(@ret,qq(method="$method")) if (defined $method);
if (defined $postfields) {
if ($postfields && ref($postfields) && (ref($postfields) eq 'HASH')) {
push(@ret,">");
foreach (keys %$postfields) {
push(@ret,qq(<postfield name="$_" value="$postfields->{$_}"/>));
}
}
push(@ret,"</go>");
} else {
push(@ret,"/>");
}
return join(" ",@ret);
}
### Method: prev
# Canned "back" method
###
sub prev {
my ($self,@p) = @_;
my ($label) = rearrange([LABEL],@p);
my $ret = qq(<do type="accept" label="Back"><prev/></do>);
$ret =~ s/Back/$label/ if (defined $label);
return $ret;
}
sub back {
&prev;
}
### Method: timer
# Make a WML timer element
####
sub timer {
my ($self,@p) = @_;
my ($name,$value) = rearrange([NAME,VALUE],@p);
return qq(<timer name="$name" value="$value"/>);
}
#### Method: end_wml
# End an WML document.
# Trivial method for completeness. Just returns "</wml>"
####
sub end_wml {
return "</wml>\n";
}
# AJM Added a new line to terminate the file
#### Method: input
# Make a text-entry box.
####
sub input {
my ($self,@p) = @_;
my ($name,$value,$type,$format,$title,$size,$maxlength,$emptyok) =
rearrange([NAME,VALUE,TYPE,FORMAT,TITLE,SIZE,MAXLENGTH,EMPTYOK],@p);
my @ret;
push(@ret,qq(<input name="$name"));
push(@ret,qq(value="$value")) if (defined $value);
push(@ret,qq(type="$type")) if (defined $type);
push(@ret,qq(format="$format")) if (defined $format);
push(@ret,qq(title="$title")) if (defined $title);
push(@ret,qq(size="$size")) if (defined $size);
push(@ret,qq(emptyok="$emptyok")) if (defined $emptyok);
push(@ret,qq(maxlength="$maxlength")) if (defined $maxlength);
push(@ret,qq(/>));
return join(" ",@ret);
}
#### Method: onevent
# Make an "onevent" block
####
sub onevent {
my ($self,@p) = @_;
my ($type,$content) = rearrange([TYPE,CONTENT],@p);
return qq(<onevent type="$type">$content</onevent>);
}
### Method: img
# make an image tag
####
sub img {
my ($self,@p) = @_;
my ($alt, $src, $localsrc, $vspace, $hspace, $align, $height, $width) =
rearrange([ALT, SRC, LOCALSRC, VSPACE, HSPACE, ALIGN, HEIGHT, WIDTH],@p);
my @ret;
$alt = "image" if (! defined $alt); # alt text is manditory in WML
push (@ret,qq(<img));
push (@ret,qq(alt="$alt")) if (defined $alt);
push (@ret,qq(src="$src")) if (defined $src);
push (@ret,qq(localsrc="$localsrc")) if (defined $localsrc);
The most up to date version of this module is available at
http://cgi-wml.sourceforge.net/
=head1 FUNCTIONS
The library provides an object-oriented method of creating correct WML,
together with some canned methods for often-used tasks. As this module
is a subclass of CGI.pm, the same argument-passing method is used, and
arguments may be passed in any order.
=head2 CREATING A WML DECK
=over 2
=item B<header()>
This function now overrides the default CGI.pm 'Content-type: ' header
to be 'text/vnd.wap.wml' by default. All the standard CGI.pm header functions
are still available for use.
print $query->header();
-or-
print $query->header(-expires=>"+1m",
-Refresh=>'20; URL='/newplace.wml');
=item B<start_wml()>
Use the start_wml method to create the start of a WML deck, if you
wish you can pass paramaters to the method to define a custom DTD,
XML language value and any 'META' information. If a DTD is not specified
then the default is to use C<WML 1.1>
$query->start_wml(-dtd => '-//WAPFORUM//DTD WML 5.5//EN',
-dtd_url => 'http://www.wapforum.org/DTD/wml_5.5.xml',
-lang => 'en-gb',
-encoding => 'iso-8859-1',
-meta => {'scheme'=>'foobar',
'name' =>'mystuff'} );
There is no direct support for the HTTP-EQUIV type of <meta> tag. This is
because you can modify the HTTP header directly with the header() method.
For example, if you want to send the Cache-control: header, do it in the
header() method:
$q->header(-cache_control=>'No-cache; forua=true');
=item B<end_wml()>
Use end_wml() to end the WML deck. Just included for completeness.
=back
=head2 CREATING WML CARDS
=over 2
=item B<card()>
Cards are created whole, by passing paramaters to the card() method, as
well as the card attributes, a timer may be added to the start of the
card.
$query->card(-id=>"card_id",
-title=>"First Card",
-ontimer=>"#next_card",
-timer=>$query->C<timer>(-name=>"timer1",-value=>"30"),
-newcontext=>"true",
-onenterforward=>"#somecard",
-onenterbackward=>"#othercard",
-content=>"<p>Hello WAP world</p>");
The 'ID' and 'Content' elements are manditory, and have no defaults.
At least one paragraph tag is also required. If you get everything
else correct and nothing is diplayed, that may be the reason. All
other parameters are optional.
An other way of making the above card would be this:
$content = $query->p("Hello WAP world");
$query->card(-id=>"card_id",
-title=>"First Card",
-ontimer=>"#next_card",
-timer=>$query->C<timer>(-name=>"timer1",-value=>"30"),
-newcontext=>"true",
-onenterforward=>"#somecard",
-onenterbackward=>"#othercard",
-content=>$content);
=head2 TEMPLATES
The template() method creates a template for placing at the start
of a card. If you just need to add a B<back> link, use the prev()
method.
$query->template(-content=>$query->prev(-label=>"Go Back"));
=head2 TIMERS
A card timer is used with the card() method to trigger an action, the
function takes two arguments, the name of the timer and it's value in
milliseconds.
$query->timer(-name=>"mytimer",
-value=>"30");
=head2 GO BLOCKS
A E<lt>go block is created either as a single line
$query-E<gt>go(-method=>"get",
-href=E<gt>"http://www.example.com/");
C<
E<lt>go href="http://www.example.com/" method="get"/E<gt>
>
or as a block
%pfs = ('var1'=E<gt>'1',
'var2'=E<gt>'2',
'varN'=E<gt>'N');
$query-E<gt>go(-method=E<gt>"post",
-href=E<gt>"http://www.example.com/",
-postfields=>\%pfs);
E<lt>go href="http://www.example.com/" method="get"E<gt>
E<lt>postfield name="var1" value="1"/E<gt>
E<lt>postfield name="var2" value="2"/E<gt>
E<lt>postfield name="varN" value="N"/E<gt>
E<lt>/goE<gt>
depending on wether it is passed a hash of postfields.
=head2 DO
$query-E<gt>do(-type=>"options",
-label=>"Menu",
-content=>qq(go href="#menu"/>));
gives
<do type="options" label="Menu" >
<go href="#menu"/>
</do>
=head2 PREV
A canned 'back' link, takes an optional label argument. Default label
is 'Back'. For use in B<templates>
$query->prev(-label=>"Reverse");
<do type="accept" label="Reverse"><prev/></do>
=head2 INPUT
Create an input entry field. No defaults, although not all arguments need
to be specified.
$query->input(-name=>"pin",
-value=>"1234",
-type=>"text",
-size=>4,
-title=>"Enter PIN",
-format=>"4N",
-maxlength=>4,
-emptyok=>"false");
=head2 ONEVENT
An B<onevent> element may contain one of 'go','prev','noop' or 'refresh'
and be of type 'onenterforward', 'onenterbackward' or 'ontimer'.
$query->onevent(-type=>"onenterforward",
-content=>qq(<refresh>
<setvar name="x" value="1"/>
</refresh>));
=head2 IMG
An image can be created with the following attributes:
alt Text to display in case the image is not displayed
align can be top, middle, bottom
src The absolute or relative URI to the image
localsrc a variable (set using the setvar tag) that refers to an image
this attribute takes precedence over the B<src> tag
vspace
hspace amount of white space to inserted to the left and right
of the image [hspace] or above and below the image [vspace]
height
width These attributes are a hint to the user agent to leave space
for the image while the page is rendering the page. The
user agent may ignore the attributes. If the number length
is passed as a percent the resulting image size will be
relative to the amount of available space, not the image size.
my $img = $query->img(
-src => '/icons/blue_boy.wbmp',
-alt => 'Blue Boy',
-localsrc => '$var',
-vspace => '25',
-hspace => '30
-align => 'bottom',
-height => '15',
-width => '10');
I<NOTE> the B<localsrc> element, and formatting elements are not supported
consistently by the current generation of terminals, however they B<should>
simply ignore the attributes they do not understand.
=head2 Dial Tags
When using cell phones in WAP you can make calls. When a dial tag is
selected the phone drops out of the WAP stack and into what ever is the
protocol used for phone calls. At the conclusion of the call the phone
I<should> return to the WAP stack in the same place that you linked to
the phone number.
The tag looks much like a regular link, but has some special syntax.
$query->dialtag(-label =>"Joe's Pizza",
-number=>"12125551212");
The recieving terminal must support WTAI for this link to work.
=head1 WML SHORTCUTS
I<p> I<b> I<br> I<table> etc. etc. Just like the original CGI.pm, this
module includes functions for creating correct WML by calling methods of
a query object.
( run in 1.431 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )