#!/usr/bin/perl

use strict;
use CGI;
use HTML::Parser;
use LWP::UserAgent;

use vars qw($program $version);
$program = 'Html2Wml';
$version = '0.2.0';

=head1 NAME

Html2Wml - Program that can convert HTML pages to WML pages

=head1 SYNOPSIS

in a shell:

    html2wml.cgi <file|url>

as a CGI:

    /cgi-bin/html2wml.cgi?url=<url>

=head1 DESCRIPTION

Html2Wml tries to convert (quite lossely) HTML pages to WML pages. 
WML support is currently minimal: the result pages should be viewable on 
Wap browser, but there aren't optimized. 

=head1 VERSION HISTORY

=over 4

=item v0.2.0, Saturday, November 11, 2000

first functional version; now uses HTML::Parser v3

=item v0.1.0, Friday, November 10, 2000

prototype version

=back

=head1 COPYRIGHT

Html2Wml is Copyright (C)2000 SE<eacute>bastien Aperghis-Tramoni.

This program is free software. You can redistribute it and/or modify it 
under the terms of either the Perl Artistic License or the GNU General 
Public License, version 2 or later. 

=cut


# 
# globals
# 
my $cgi = new CGI;
my $res;

## variables used by the html parser
my($OUT,$skip);

my %with = (
    html   => { action => 'replace',   new_value => 'wml'  }, 
    
    ## HEAD tags
    title  => { action => 'skip' }, 
    style  => { action => 'skip' }, 
    
    ## structural tags
    body   => { action => 'replace',   new_value => 'card' }, 
    table  => { action => 'keep' }, 
    tr     => { action => 'keep' }, 
    td     => { action => 'keep' }, 
    p      => { action => 'keep' }, 
    
    ## link tags
    a      => { action => 'keep',      attributes => 'href' }, 
    
    ## font tags
    b      => { action => 'keep' }, 
    i      => { action => 'keep' }, 
    strong => { action => 'keep' }, 
    em     => { action => 'keep' }, 
);

       push @ARGV, 'test.html';
# 
# main
# 
if(@ARGV) {
    $res = html2wml(shift)
} else {
    $res = html2wml($cgi->param('url'))
}

print $cgi->header(-status => 'text/vnd.wap.wml'), 
      $res;



# 
# html2wml()
# --------
sub html2wml {
    my $url = shift;
    my $page;
    my %attr;
    my $converter = new HTML::Parser api_version => 3;
    
    ## read the file (from the disk or the net)
    if($url =~ m{http://}) {
        $page = get_url($url)
    } else {
        $page = read_file($url)
    }
    
    ## Gather information from the HTML page
    if($page =~ m/<title>(.*)<\/title>/is) {
        $attr{title} = $1
    }
    
    ## conversion
    $skip = 0;
    $OUT = q|<?xml version="1.0"?>| . $/ 
         . q|<!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.2//EN" |
         . q|"http://www.wapforum.org/DTD/wml12.dtd">|;
    
    $converter->unbroken_text(1);
    $converter->handler(start       => \&start,  'tagname, attr, attrseq, text');
    $converter->handler(end         => \&end,    'tagname, text');
    $converter->handler(text        => \&text,   'text, is_cdata');
    $converter->handler(declaration => '');
    $converter->handler(comment     => '');
    $converter->handler(process     => '');
    
    $converter->parse($page);
    $converter->eof;
    
    ## post-conversion clean-up
    $OUT =~ s/\n+/\n/go;
    
    if(length $attr{title}) {
        $OUT =~ s/<card>/<card title="$attr{title}">/;
    }
    
    return $OUT
}


# 
# get_url()
# -------
sub get_url {
    my $url = shift;
    my $ua = new LWP::UserAgent;
    $ua->agent("$program/$version " . $ua->agent);
    my $request = new HTTP::Request GET => $url;
    my $response = $ua->request($request);
    
    if($response->is_error) {
        return $response->error_as_HTML
    }
    
    return $response->content
}


# 
# read_file()
# ---------
sub read_file {
    my $file = shift;
    local $/ = undef;
    open(FILE, $file) or die "can't read file '$file': $! ";
    $file = <FILE>;
    close(FILE);
    return $file
}


# 
# functions used by the HTML parser
# 
  
sub start {
    my($tag, $attr) = @_;
    
    $attr = join ' ', map { "$_=\"$attr->{$_}\"" if $attr->{$_}} split(',', $with{$tag}{attributes});
    $attr = ' ' . $attr if length $attr;
    
    $skip = 1 if $with{$tag}{action} eq 'skip';
    
    if($with{$tag}{action} eq 'keep') {
        $OUT .= "<$tag$attr>"
    
    } elsif($with{$tag}{action} eq 'replace') {
        $OUT .= "<$with{$tag}{new_value}$attr>"
    
    } else {
        ## do nothing
    }
}
  
sub end {
    my($tag) = @_;
    
    $skip = 0 if $with{$tag}{action} eq 'skip';
    
    if($with{$tag}{action} eq 'keep') {
        $OUT .= "</$tag>";
    
    } elsif($with{$tag}{action} eq 'replace') {
        $OUT .= "</$with{$tag}{new_value}>"
    
    } else {
        ## do nothing
    }
}
  
sub text {
    my($text) = @_;
    $OUT .= $text unless $skip
}





