HTML::WikiConverter::WebApp - Web interface to HTML::WikiConverter

  #!/usr/bin/perl
  use HTML::WikiConverter::WebApp;

  my %config = (
    template_path => '/path/to/web/templates',
  );

  HTML::WikiConverter::WebApp->new( PARAMS => \%config )->run;

  perldoc HTML::WikiConverter::WebApp

package HTML::WikiConverter::WebApp;
use base 'CGI::Application';

use HTML::WikiConverter;
use XML::Writer;
use Tie::IxHash;
use Encode;

sub setup {
  my $self = shift;
  $self->error_mode( 'display_error' );
  $self->tmpl_path( $self->param('template_path') );
  $self->mode_param( 'm' );
  $self->start_mode( 'new' );
  $self->run_modes(
    new     => 'new_page',
    convert => 'output_page',
  );
  $self->header_add( -charset => 'utf-8' );
}

sub new_page {
  my $self = shift;
  my $q = $self->query;

  my $tmpl = $self->load_template( 'main.html' );
  $tmpl->param(
    $self->_default_template_params,
  );

  $tmpl->output;
}

sub output_page {
  my $self = shift;
  my $q = $self->query;

  my $source_type = $q->param('source_type') or die "need source_type";
  my $dialect = $q->param('dialect') or die "need dialect";

  die "unknown source_type '$source_type'" unless $self->_known_source_type( $q->param('source_type') );

  my %source;
  SWITCH: {
    %source = ( html => $q->param('html') ),   last if $source_type eq 'raw_html';
    %source = ( html => $self->_sample_html ), last if $source_type eq 'sample_html';
    %source = ( uri  => $q->param('uri') ),    last if $source_type eq 'from_uri';
  };

  die sprintf( "no %s was provided", (keys %source)[0] ) unless ( (values %source)[0] );

  my $wc = new HTML::WikiConverter(
    dialect         => $dialect,
    base_uri        => $q->param('base_uri'),
    wiki_uri        => $q->param('wiki_uri'),
    escape_entities => $q->param('escape_entities'),
  );

  my $wiki = $wc->html2wiki( %source );
  my $parsed_html = $wc->parsed_html;

  $source{html} = decode( $wc->encoding, $source{html} ) if $source{html};
  $wiki         = decode( $wc->encoding, $wiki )         if $wiki;

  my $format = $q->param('format') || 'html';
  if( $format eq 'xml' ) {
    tie( my %default_template_params, 'Tie::IxHash' );
    %default_template_params = $self->_default_template_params;

    my %ignore_params = map { $_ => 1 } qw(
      dialects
      error
      raw_html
      from_uri
      sample_html
      uri
    );

    my $xml = '';
    my $writer = new XML::Writer( OUTPUT => \$xml, DATA_MODE => 1, DATA_INDENT => 2 );
    $writer->xmlDecl('utf-8');
    $writer->startTag( 'wikitool', application => 'html2wiki' );
    
    $writer->startTag( 'query' );
      $writer->startTag( 'source', type => $source_type );
      $writer->characters( (values %source)[0] );
      $writer->endTag();

      $writer->startTag( 'options' );
      while( my( $f, $v ) = each %default_template_params ) {
        next if $ignore_params{$f};
        $writer->startTag( $f );
        $writer->characters( $v );
        $writer->endTag();
      }
      $writer->endTag();
    $writer->endTag();

    $writer->startTag( 'response' );
      if( $q->param('show_parsed_html') ) {
        $writer->startTag( 'parsed_html' );
        $writer->characters( $parsed_html );
        $writer->endTag();
      }

      $writer->startTag( 'wiki_markup' );
      $writer->characters( $wiki );
      $writer->endTag();

      $writer->endTag();
    $writer->endTag();

    $self->header_add( -type => 'text/xml' );
    return $xml;
  }

  my $temp = $self->load_template( 'main.html' );
  $temp->param(
    $self->_default_template_params,
    uri         => $source{uri},
    html        => $source{html},
    parsed_html => $parsed_html,
    wiki_markup => $wiki,
  );

  return $temp->output;
}

sub _default_template_params {
  my $self = shift;
  my $q = $self->query;

  my $source_type = $self->_known_source_type( $q->param('source_type') ) ? $q->param('source_type') : 'raw_html';

  return (
    dialect => $q->param('dialect') || '',
    $source_type => 1,

    uri => $q->param('uri') || '',

    base_uri => $q->param('base_uri') || '',
    wiki_uri => $q->param('wiki_uri') || '',

    show_parsed_html => $q->param('show_parsed_html') || 0,
    escape_entities  => $q->param('escape_entities') || 0,

    dialects => $self->_dialects,
    error => '',
  );
}

my %known_source_types = map { $_ => 1 } qw(
  from_uri
  raw_html
  sample_html
);

sub _known_source_type {
  my( $self, $type ) = @_;
  return exists $known_source_types{$type};
}

sub _dialects {
  my $self = shift;
  my $q = $self->query;

  my $selected_dialect = $q->param('dialect') || '';

  my @dialects;
  my %seen;
  foreach my $dialect ( HTML::WikiConverter->available_dialects ) {
    next if $seen{$dialect}++;
    push @dialects, { dialect => $dialect, selected => ( $selected_dialect eq $dialect ) };
  }

  return \@dialects;
}

sub load_template {
  my( $self, $file ) = @_;
  return $self->load_tmpl( $file, die_on_bad_params => 1, loop_context_vars => 1, cache => 1 );
}

sub _sample_html {
  my $self = shift;
  return $self->load_template( 'sample_html.html' )->output;
}

sub display_error {
  my( $self, $error ) = @_;

  if( $error =~ /Dialect .* could not be loaded/ ) {
    $error = sprintf q{The "%s" dialect either doesn't exist or has not been installed.}, $self->query->param('dialect');
  }

  $error =~ s{(.*?) at \S+ line \d+\.}{$1.};
  $error = ucfirst $error;

  my $tmpl = $self->load_template( 'main.html' );
  $tmpl->param(
    $self->_default_template_params,
    error => $error
  );

  return $tmpl->output;
}

1;