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

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";
<do type="$type" label="$label">
EOF

	$self->{'_do'} .= $task eq 'prev' ?  '<prev/>' : "<go href=\"$href\"/>";
	$self->{'_do'} .= '</do>';
}

sub table{
	my $self = shift;
	my ($data,  $title, $offset, $pager, @headers) = @_;
	my $texto;
	my $i;
	my $total = scalar @{$data};
	
	$self->{'_body'}.= "<p align='center'>$title";
	$self->{'_body'}.= "<table  columns='3'>";
	
	#Header
	if (scalar @headers) {
			$self->{'_body'}.= '<tr><td>&nbsp;</td>';
			for ($i=0; $i < 2; $i++) {
				$self->{'_body'}.= '<td>';
				$texto = $self->_format_text($headers[$i]);
				$self->{'_body'}.= "$texto</td>";
			}
			$self->{'_body'}.= '</tr>';
	}

	#Datos
	for ($i=($offset * $pager); (($i < ($offset * $pager + $pager)) && ($i < $total));$i++) {
			$self->{'_body'}.= "<tr><td>&nbsp;</td>";
			for (my $j; $j < 2 ; $j++) {
				$self->{'_body'}.= "<td>";
				$texto = $self->_format_text($data->[$i][$j]);
				$self->{'_body'}.= "$texto</td>";
			}
			$self->{'_body'}.= '</tr>';
	}
	$self->{'_body'}.= "</table></p>";
	$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/\&/\&amp;/gs;
			$self->{'_body'}.= << "EOF";
			<p><a href=\"$href\">$next</a></p>
EOF
	}
}

sub link_list{
	my $self = shift;
	my ($name, $listtitle, $offset, $pager, $data, $align)  = @_;
	$align = defined $align ? $align : 'left';
	$self->{'_body'}.= "<p align=\"$align\">";
	$self->{'_body'}.=  sprintf ("%s", $self->_format_text($listtitle))  if defined $listtitle;
	$name = $self->_format_text($name);
	$self->{'_body'}.=  "<select ivalue=\"0\" name=\"$name\">\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'}.= "<option onpick=\"$data->[$i][1]\">$opt</option>\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/\&/\&amp;/gs;
		$self->{'_body'}.= << "EOF";
<option onpick=\"$href\">$next</option>
EOF
	}

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


sub value_list{
	my $self = shift;
	my ($name, $listtitle, $offset,$pager,$data)  = @_;
	$self->{'_body'}.=  '<p mode="nowrap">';
	$self->{'_body'}.=  sprintf ("%s", $self->_format_text($listtitle))  if defined $listtitle;
	$name = $self->_format_text($name);
	$self->{'_body'}.=  "<select ivalue=\"0\" name=\"$name\">\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'}.= "<option value=\"$data->[$i][1]\">$opt</option>\n";
	}
	$self->{'_body'}.= << "EOF";
</select>
</p>
EOF
};

sub print{
	my  $self = shift;
	$self->{'_title'} = $self->_format_text($self->{'_title'});
	print << "EOF";
<card id="$self->{'_id'}" title="$self->{'_title'}">
$self->{'_do'}
$self->{'_body'}
</card>
EOF
};

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

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

sub input{
	my  $self = shift;
	my ($label, $text, $name, $format, $type, $size, $target, $arg) = @_;
	$target = defined $arg ? "$target?$arg&amp;$name=\$($name)" : "$target?$name=\$($name)";
	$format = " format=\"$size$format\"" if defined $format;
	$size = " size=\"$size\"" if defined $size ;
	$self->{'_body'} .= << "EOF";
<do type="accept" label="$label">
	<go href="$target"/>
</do>
<p align="center" mode="wrap">
$text
<input type="$type" name="$name" title="$name" $format $size/>
<a href="$target">$label</a>
</p>
EOF
}

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


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

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


1;