#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use v5.10;
use Data::Dumper;
use IO::File;
use WriteAt;
use Perl6::Pod::Utl;
use Perl6::Pod::Lib;

my ( $help, $man );
my ( $type, $lang ) = ( "docbook", 'en' );
my %opt = (
    help => \$help,
    man  => \$man,
    type => \$type,
    lang => \$lang
);
GetOptions( \%opt, 'help|?', 'man', 'c=s', "type|t:s", 'lang=s' )
  or pod2usage(2);
pod2usage(1) if $help;
pod2usage( -exitstatus => 0, -verbose => 2 ) if $man;

unless ($type) {
    pod2usage( -exitstatus => 2, -message => 'Need valide -type !' );
}

{
    my $infile = shift;
    my $in_fd;
    if ($infile) {
        $in_fd = new IO::File:: "< $infile" or die "$infile: $!";
    }
    else {
        $in_fd = \*STDIN;
    }
    my $in;
    { local $/; undef $/; $in = <$in_fd> };
    utf8::decode($in) unless utf8::is_utf8($in);
    my $tree = Perl6::Pod::Utl::parse_pod( $in, default_pod => 1 )
      || die "Can't parse $infile";
    my $r = new WriteAt::To::DocBook::;

    #set src key for path
    $r->context->custom->{src} = $infile;
    no strict 'refs';
    my $pod6use = ${"Perl6::Pod::Lib::POD6USE"};
    if ($pod6use) {
        while ( my ( $k, $v ) = each %$pod6use ) {
            $r->context->use->{$k} = $v;
        }
    }
    use strict 'refs';
    $r->context->use->{CHANGES} = 'WriteAt::CHANGES';
    $r->context->use->{AUTHOR}  = 'WriteAt::AUTHOR';

    my $w   = $r->writer();
    my $dtd = '';
    for (
        '/usr/local/share/xml/docbook/4.5/docbookx.dtd',
        '/usr/share/xml/docbook/schema/dtd/4.5/docbookx.dtd'
      )
    {
        if ( -e $_ ) {
            $dtd = $_;
            last;
        }
    }
    die "Can't find docbookx.dtd file" unless $dtd;
    $w->raw(<<"H");
<?xml version='1.0' encoding="UTF-8"?>
<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.3CR1//EN"
        "file://${dtd}" []>
<book lang="$lang">
<bookinfo>
H
    my %res;
    $tree = &WriteAt::get_book_info_blocks( $tree, \%res, $r );
    for (qw/ TITLE SUBTITLE AUTHOR CHANGES DESCRIPTION /) {
        my $n = $res{$_} || die "Cant find block =$_";

        #make Document element
        $r->visit($n);
    }
    $r->w->raw('</bookinfo>');
    $r->write($tree);
    $r->end_write();
    $w->raw('</book>');

}

exit 0;

=head1 NAME

  writeat  - process pod6 files

=head1 SYNOPSIS

  writeat -type docbook  file.pod6 > file.xml

   options:

    -help  - print help message
    -man   - print man page
    

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exit

=item B<-man>

Prints manual page and exit

=back

=head1 DESCRIPTION

    writeat  - process pod6 files

=head1 EXAMPLE

   writeat -type docbook < book.pod6

=head1 AUTHOR

Zahatski Aliaksandr, E<lt>zahatski@gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2012 by Zahatski Aliaksandr

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

