File Coverage

blib/lib/WML/Card.pm

Criterion	Covered	Total	%
statement	25	123	20.3
branch	2	26	7.6
condition	1	12	8.3
subroutine	5	16	31.2
pod	11	12	91.6
total	44	189	23.2

package WML::Card;

use strict;
use Data::Dumper;
use vars qw($VERSION);

$VERSION = '0.02';

my $pt = [
	{ 'ua' => '7110', 'ot' => 'WML::Card::7110' },
	{ 'ua' => '7160', 'ot' => 'WML::Card::7110' },
	{ 'ua' => 'wapsilon', 'ot' => 'WML::Card::7110' },
	{ 'ua' => 'motorola', 'ot' => 'WML::Card::UP' },
	{ 'ua' => 'up', 'ot' => 'WML::Card::UP' },
	{ 'ua' => 'wapman', 'ot' => 'WML::Card::Palm' },
	{ 'ua' => 'ezwapbrowser', 'ot' => 'WML::Card::Palm' },
	{ 'ua' => 'nokia-wap-toolkit', 'ot' => 'WML::Card' },
];


sub guess {
	shift;
	my $id = shift;
	my $title =shift;
	my $ua = shift || $ENV{'HTTP_USER_AGENT'};
	my $ot = 'WML::Card';
	for my $p (@$pt) {
		if ($ua =~ /$p->{'ua'}/i) {
			$ot = $p->{'ot'};
			last;
		}
	}
	eval "require $ot";

	# if ($@) { ...
	# } else { ...
	# }

	my $ob = new $ot($id, $title);
	return $ob;
}

sub new {
	my $cl = shift;
	my ($_id, $_title) = @_;
	my $hr = {
		'_id' => $_id,
		'_title' => $_title,
		'_do'=> undef,
		'_body'=> undef,
		'_next'=> 'Ver más',
	 };
	return bless $hr, $cl;
}


sub buttons{
	my $self =shift;
	my ($label, $type, $task, $href) = @_;
	$self->{'_do'} .= << "EOF";

EOF

	$self->{'_do'} .= $task eq 'prev' ?  '' : "";
	$self->{'_do'} .= '';
}

sub table{
	my $self = shift;
	my ($data,  $title, $offset, $pager, @headers) = @_;
	my $texto;
	my $i;
	my $total = scalar @{$data};

	$self->{'_body'}.= "$title";
	$self->{'_body'}.= ""; '; "; '; "; "; '; 




77




 





 





 





 





 





 



 	 




78




 





 





 





 





 





 



 	#Header 




79




0




  
  0
  




 





 





 





 



 	if (scalar @headers) { 




80




0





 





 





 





 





 



 			$self->{'_body'}.= ' 




81




0





 





 





 





 





 



 			for ($i=0; $i < 2; $i++) { 




82




0





 





 





 





 





 



 				$self->{'_body'}.= ''; 




83




0





 





 





 





 





 



 				$texto = $self->_format_text($headers[$i]); 




84




0





 





 





 





 





 



 				$self->{'_body'}.= "$texto




85




 





 





 





 





 





 



 			} 




86




0





 





 





 





 





 



 			$self->{'_body'}.= '




87




 





 





 





 





 





 



 	} 




88




 





 





 





 





 





 



   




89




 





 





 





 





 





 



 	#Datos 




90




0





 




  
  0
  




 





 





 



 	for ($i=($offset * $pager); (($i < ($offset * $pager + $pager)) && ($i < $total));$i++) { 




91




0





 





 





 





 





 



 			$self->{'_body'}.= " 




92




0





 





 





 





 





 



 			for (my $j; $j < 2 ; $j++) { 




93




0





 





 





 





 





 



 				$self->{'_body'}.= ""; 




94




0





 





 





 





 





 



 				$texto = $self->_format_text($data->[$i][$j]); 




95




0





 





 





 





 





 



 				$self->{'_body'}.= "$texto




96




 





 





 





 





 





 



 			} 




97




0





 





 





 





 





 



 			$self->{'_body'}.= '




98




 





 





 





 





 





 



 	} 




99




0





 





 





 





 





 



 	$self->{'_body'}.= "";

	#Header
	if (scalar @headers) {
			$self->{'_body'}.= '
			for ($i=0; $i < 2; $i++) {
				$self->{'_body'}.= '
				$texto = $self->_format_text($headers[$i]);
				$self->{'_body'}.= "$texto
			}
			$self->{'_body'}.= '
	}

	#Datos
	for ($i=($offset * $pager); (($i < ($offset * $pager + $pager)) && ($i < $total));$i++) {
			$self->{'_body'}.= "
			for (my $j; $j < 2 ; $j++) {
				$self->{'_body'}.= "
				$texto = $self->_format_text($data->[$i][$j]);
				$self->{'_body'}.= "$texto
			}
			$self->{'_body'}.= '
	}
	$self->{'_body'}.= "
	$offset++;

	if ($i < $total){
			my $next =$self->_format_text($self->{'_next'});
			$ENV{'QUERY_STRING'} =~ s/^(o=\d[&]?)//;
		 	my $href = length $ENV{'QUERY_STRING'}> 0 ? "?o=$offset&$ENV{'QUERY_STRING'}" : "?o=$offset";
			$href =~ s/\&/\&/gs;
			$self->{'_body'}.= << "EOF";
			$next
EOF
	}
}

sub link_list{
	my $self = shift;
	my ($name, $listtitle, $offset, $pager, $data, $align)  = @_;
	$align = defined $align ? $align : 'left';
	$self->{'_body'}.= "";
	$self->{'_body'}.=  sprintf ("%s", $self->_format_text($listtitle))  if defined $listtitle;
	$name = $self->_format_text($name);
	$self->{'_body'}.=  "\n";

	my $total = scalar @{$data};
	my $i;
	for ($i= ($offset * $pager);
				($i < ($offset * $pager + $pager) && ($i < scalar @{$data}));
				$i++) {
			my $opt = $self->_format_text($data->[$i][$0]);
			$self->{'_body'}.= "[$i][1]\">$opt\n";
	}
	$offset++;
	if ($i < $total){
		my $next =$self->_format_text($self->{'_next'});
		$ENV{'QUERY_STRING'} =~ s/^(o=\d[&]?)//;
	 	my $href = length $ENV{'QUERY_STRING'}> 0 ? "?o=$offset&$ENV{'QUERY_STRING'}" : "?o=$offset";
		$href =~ s/\&/\&/gs;
		$self->{'_body'}.= << "EOF";
$next
EOF
	}

	$self->{'_body'}.= << 'EOF';


EOF
};


sub value_list{
	my $self = shift;
	my ($name, $listtitle, $offset,$pager,$data)  = @_;
	$self->{'_body'}.=  '';
	$self->{'_body'}.=  sprintf ("%s", $self->_format_text($listtitle))  if defined $listtitle;
	$name = $self->_format_text($name);
	$self->{'_body'}.=  "\n";

	my $total = scalar @{$data};
	for (my $i= ($offset * $pager);
				($i < ($offset * $pager + $pager) && ($i < $total));
				$i++) {
			my $opt = $self->_format_text($data->[$i][$0]);
			$self->{'_body'}.= "[$i][1]\">$opt\n";
	}
	$self->{'_body'}.= << "EOF";


EOF
};

sub print{
	my  $self = shift;
	$self->{'_title'} = $self->_format_text($self->{'_title'});
	print << "EOF";

$self->{'_do'}
$self->{'_body'}

EOF
};

sub info{
	my  $self = shift;
	my $content = shift;
	$content = $self->_format_text($content);
	$content =~ s/\n/\n/gs;
	$content = "$content";
	$content =~ s/\n<\/p>/<\/p>/;
	$self->{'_body'} .= $content;
};

sub img{
	my  $self = shift;
	my ($file, $alt) = @_;
	$self->{'_body'} .= << "EOF";



EOF
}

sub input{
	my  $self = shift;
	my ($label, $text, $name, $format, $type, $size, $target, $arg) = @_;
	$target = defined $arg ? "$target?$arg&$name=\$($name)" : "$target?$name=\$($name)";
	$format = " format=\"$size$format\"" if defined $format;
	$size = " size=\"$size\"" if defined $size ;
	$self->{'_body'} .= << "EOF";




$text

$label

EOF
}

sub link{
	my  $self = shift;
	my ($target, $text) = @_;
	$self->{'_body'} .= << "EOF";
$text
EOF
}


sub br{
	my  $self = shift;
	$self->{'_body'} .= '';
}

sub _format_text {
	my $self = shift;
    	my $txt = shift;
		$txt =~ s/([^\w\s])/sprintf '&#%03d;', ord($1)/eg;
    	$txt =~ s/\r//g;
    	$txt;
}


1;

=head1 NAME

WML::Card - Perl extension for builiding WML Cards according to the browser being used.

=head1 SYNOPSIS

use WML::Card;

my $options= [
        ['Option 1', 'http://...'],
        ['Option 2', 'http://...'],
];

my $c = WML::Card->guess('index','Wap Site');
$c->link_list('indice', undef,  0, $options,  $options);
$c->print;

=head1 DESCRIPTION

This perl library simplifies the creation of  WML cards on the fly. It produces
the most suitable wml code for the browser requesting the card. In this way the
one building the cards does not have to worry about the differences in how  each
wap browser displays the wml code. In combination wht WML::Deck it provides
functionality to build WAP applications.

=head2 Methods

=over 4

=item $card = WML::Card->guess( $id, $title, [$user_agent] );

This class method constructs a new WML::Card object.  The first argument defines
the WML card's id and the second argument its title. The if the third argument is
not defined, the value is obtained from $ENV{'HTTP_USER_AGENT'}.


=item $c->buttons($label, $type, $task, $href)


=item $c->table ($data,  $title, $offset, $pager, @headers)

=item $c->link_list($name, $listtitle, $offset, $pager, $data, $align)

=item $c->value_list($name, $listtitle, $offset,$pager,$data)

The variable $data is an array reference like:
my $menu_items= [
        ['Option 1', 'http://...'],
        ['Option 2', 'http://...'],
];

The variable $pager is the number of items wanted to be displayed in each card.

=item $c->print

=item $c->info($content)

=item $c->img($file, $alt)

=item $c->input($label, $text, $name, $format, $type, $size, $target, $arg);

=item $c->link($target, $text);

=item $c->br

=head1 AUTHOR

Mariana Alvaro			[e-mail]

Copyright 2000 Mariana Alvaro. All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

WML::Deck

=cut