Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

initial

  • Loading branch information...
commit f5f8d1b8ec9b0754ced6ae35eac7d42ec4d94559 0 parents
zag authored
23 Build.PL
@@ -0,0 +1,23 @@
+use Module::Build;
+use v5.10;
+Module::Build->new
+ ( module_name => 'Writeat',
+ license => 'perl',
+ prereq => {
+ 'Regexp::Grammars'=>1.015,
+ 'Perl6::Pod::Lib'=>0.07,
+ 'Perl6::Pod'=>0.51
+ },
+ script_files=>[qw!
+ scripts/writeat
+ !],
+ dist_version_from=>'lib/Writeat.pm',
+ meta_merge=>{
+ resources=> {
+ repository => 'git://github.com/zag/p5-Writeat.git',
+ bugtracker=>'http://rt.cpan.org/Public/Dist/Display.html?Name=Writeat'
+ }
+ },
+ dist_author=>'Zahatski Aliaksandr zag@cpan.org',
+ create_makefile_pl=>$ENV{DO_OUTCPAN} ? 'traditional':'passthrough'
+ )->create_build_script;
4 Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension Writeat.
+
+0.01
+ + initial release of Writeat suite
0  MANIFEST
No changes.
0  Makefile.PL
No changes.
32 README
@@ -0,0 +1,32 @@
+Writeat
+=====================
+
+Writeat - suite for make books and docs in pod6 format
+
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ Regexp::Grammars;
+ Perl6::Pod::Lib
+ Perl6::Pod
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2012 by Zahatski Aliaksandr
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10 or,
+at your option, any later version of Perl 5 you may have available.
+
+
85 lib/Writeat.pm
@@ -0,0 +1,85 @@
+#===============================================================================
+#
+# DESCRIPTION: Writeat - suite for book writers
+#
+# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
+#===============================================================================
+package Writeat;
+
+=head1 NAME
+
+Writeat - suite for make books and docs in pod6 format
+
+=head1 SYNOPSIS
+
+ writeat init
+ make
+
+=head1 DESCRIPTION
+
+Books must be high available for readers and writers !
+Writeat - suite for free book makers. It help make and prepare book for publishing.
+
+=cut
+
+use strict;
+use warnings;
+use v5.10;
+our $VERSION = '0.01';
+use Writeat::CHANGES;
+use Writeat::AUTHOR;
+use Writeat::To::DocBook;
+
+=head1 FUNCTIONS
+
+=cut
+
+sub get_book_info_blocks {
+ my $tree = shift;
+ my $res = shift || return;
+ my @nodes = ref( $tree ) eq 'ARRAY' ? @$tree : ($tree);
+ my @tree = ();
+ foreach my $n (@nodes) {
+ unless (ref($n)){ #skip text
+ push @tree, $n;
+ next;
+ }
+ if ($n->name =~ /^(CHANGES|SUBTITLE|AUTHOR|TITLE|DESCRIPTION)$/ ) {
+ $res->{$n->name} = $n;
+ } else {
+ push @tree,$n;
+ $n->childs(
+ &get_book_info_blocks( $n->childs , $res )
+ )
+ }
+ }
+ \@tree
+}
+
+=head1 METHODS
+=cut
+sub new {
+ my $class = shift;
+ bless( ( $#_ == 0 ) ? shift : {@_}, ref($class) || $class );
+}
+
+1;
+__END__
+
+=head1 SEE ALSO
+
+Perl6::Pod
+
+=head1 AUTHOR
+
+Zahatski Aliaksandr, <zag@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 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
+
53 lib/Writeat/AUTHOR.pm
@@ -0,0 +1,53 @@
+#===============================================================================
+#
+# DESCRIPTION: Author SECTION
+#
+# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
+#===============================================================================
+#$Id$
+package Writeat::AUTHOR;
+use strict;
+use warnings;
+use Perl6::Pod::Block;
+use base 'Perl6::Pod::Block';
+
+=pod
+
+Convert:
+
+ *AUTHOR
+ firstname: Alex
+ surname: Bom
+ lineage: Bred
+
+To
+
+ <author>
+ <firstname>Alex</firstname>
+ <lineage>Bred</lineage>
+ <surname>Bom</surname>
+ </author>
+
+=cut
+
+sub parse_content {
+ my $self = shift;
+ my $t = shift;
+ my %items = $t=~m/^(\w+)\s*:\s*(.+?)\s*$/mg;
+ return \%items;
+}
+
+sub to_docbook {
+ my ( $self, $to )= @_;
+ my $w = $to->w;
+ $w->raw('<author>');
+ my $rec = $self->parse_content( $self->childs->[0]->childs->[0] );
+ while( my ($k, $v) = each %$rec ) {
+ $w->raw("<$k>");
+ $w->print("$v");
+ $w->raw("</$k>");
+ }
+ $w->raw('</author>');
+}
+1;
+
73 lib/Writeat/CHANGES.pm
@@ -0,0 +1,73 @@
+#===============================================================================
+#
+# DESCRIPTION: Block CHANGES
+#
+# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
+#===============================================================================
+package Writeat::CHANGES;
+use strict;
+use warnings;
+use Perl6::Pod::Block;
+use base 'Perl6::Pod::Block';
+
+=pod
+From
+ =CHANGES
+ date (revnumber) (\t|\s{2,} ) revremark [authorinitials]
+
+ =CHANGES :authorinitials('zag')
+ 06.04.2011(v0.15)[zag] test text
+ some text at line
+
+to
+ <revhistory>
+ <revision>
+ <revnumber>v0.15</revnumber>
+ <date>Feb 10th 2011</date>
+ <authorinitials>zag</authorinitials>
+ <revremark>test text</revremark>
+ </revision>
+ </revhistory>
+=cut
+
+sub to_docbook {
+ my ( $self, $to ) = @_;
+ my $w = $to->w;
+ $w->raw('<revhistory>');
+ my $recs = $self->parse_content($self->{''});
+ foreach my $rec (@$recs) {
+ $w->raw('<revision>');
+ while( my ($k, $v) = each %$rec) {
+ next unless $k;
+ $w->raw("<$k>");
+ $w->print($v);
+ $w->raw("</$k>");
+ }
+ $w->raw('</revision>');
+ }
+ $w->raw('</revhistory>');
+}
+
+sub parse_content {
+ my $self = shift;
+ my $txt = shift;
+ my $r = do {
+ use Regexp::Grammars;
+ qr{
+ \A .*? <[lines=line]>+ % ([\s\n]+) (^ = .* )?\Z
+ #Sep 19th 2011(v0.7)[zag] ¿¿¿¿¿¿ ¿ ¿¿¿¿¿¿¿
+ <rule: line><nocontext:>^
+ (?!=) <date=(.*?)>
+ \( <revnumber=(.*?)> \)
+ \[ <authorinitials=(\w+)> \]
+ <revremark=(.*?)>
+ }xms
+ };
+ if ($txt =~ $r ) {
+ return $/{lines}
+ } else {
+ die 'error parse CHANGES'
+ }
+}
+1;
+
13 lib/Writeat/To.pm
@@ -0,0 +1,13 @@
+#===============================================================================
+#
+# DESCRIPTION:
+#
+# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
+#===============================================================================
+package Writeat::To;
+sub block_DESCRIPTION {};
+sub block_SUBTITLE{};
+sub block_TITLE{};
+1;
+
+
55 lib/Writeat/To/DocBook.pm
@@ -0,0 +1,55 @@
+#===============================================================================
+#
+# DESCRIPTION: DocBook
+#
+# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
+#===============================================================================
+package Writeat::To::DocBook;
+use Perl6::Pod::Utl;
+use Writeat::To;
+use base ('Perl6::Pod::To::DocBook', 'Writeat::To');
+
+sub block_DESCRIPTION {
+ my ($self, $n) = @_;
+ my $w = $self->w;
+ $w->raw('<abstract>');
+ $self->visit_childs($n);
+ $w->raw('</abstract>');
+};
+
+sub block_TITLE{
+ my ($self, $n) = @_;
+ my $w = $self->w;
+ $w->raw('<title>');
+ $self->visit_childs($n);
+ $w->raw('</title>');
+};
+
+sub block_SUBTITLE{
+ my ($self, $n) = @_;
+ my $w = $self->w;
+ $w->raw('<subtitle>');
+ $self->visit_childs($n);
+ $w->raw('</subtitle>');
+};
+
+
+sub block_CHAPTER {
+ my ( $self, $node ) = @_;
+ #close any section
+ $self->switch_head_level(0);
+ $self->w->raw('</chapter>') if $self->{IN_CHAPTER};
+ $self->w->raw('<chapter>') && $self->{IN_CHAPTER}++;
+ $self->w->raw('<title>')->print($node->childs->[0]->childs->[0])
+ ->raw('</title>');
+}
+
+sub end_write {
+ my $self = shift;
+ $self->SUPER::end_write();
+ $self->w->raw('</chapter>') if $self->{IN_CHAPTER};
+}
+1;
+
+
+
146 scripts/writeat
@@ -0,0 +1,146 @@
+#!/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, $package, $mode, $port ) = ( "perl5", 'MyApp::Tmpl', 'soy', 8080 );
+my %opt = (
+ help => \$help,
+ man => \$man,
+ type => \$type,
+ package => \$package,
+ mode => \$mode,
+ port => \$port,
+);
+GetOptions( \%opt, 'help|?', 'man', 'c=s', "type|t:s", 'package|p=s',
+ 'mode|m=s', 'port=s' )
+ or pod2usage(2);
+pod2usage(1) if $help;
+pod2usage( -exitstatus => 0, -verbose => 2 ) if $man;
+
+unless ($type) {
+ pod2usage( -exitstatus => 2, -message => 'Need valide -type !' );
+}
+
+if ( $type =~ /^perl/ and !$package ) {
+ pod2usage( -exitstatus => 2, -message => 'Need valide -package !' );
+}
+{
+ 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> };
+ my $tree = Perl6::Pod::Utl::parse_pod( $in, default_pod => 1 ) || die "Can't parse $infile";
+ my %res;
+ $tree = &Writeat::get_book_info_blocks( $tree, \%res );
+ 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="ru">
+<bookinfo>
+H
+ 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 -package MyApp::Tmpl file.po6 > 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 -package MyApp::Tmpl < file.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
+
79 t/01.bookinfo.t
@@ -0,0 +1,79 @@
+#===============================================================================
+#
+# DESCRIPTION: Test get bookinfo blocks
+#
+# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
+#===============================================================================
+
+
+
+package main;
+use strict;
+use warnings;
+use v5.10;
+use Test::More tests => 1; # last test to print
+use Perl6::Pod::Utl;
+use Data::Dumper;
+use Writeat;
+
+=head2 flat_pod $tree, &sub_ref( $node )
+
+=cut
+
+sub flat_pod {
+ my $tree = shift;
+ my $sub = shift || return;
+ my @nodes = ref( $tree ) eq 'ARRAY' ? @$tree : ($tree);
+ foreach my $n (@nodes) {
+ next unless ref($n); #skip text
+ return 1 if ( $sub->( $n ));
+ if ( my $sub_tree = $n->childs ) {
+ return 1 if &flat_pod($n->childs, $sub)
+ }
+ }
+}
+
+
+my $t = <<T;
+=begin pod
+=TITLE asdasd
+=SUBTITLE asdasd
+=DESCRIPTION
+asd asd
+=begin CHANGES
+Sep 19th 2011(v0.7)[zag] Классы и объекты
+
+May 13th 2011(v0.6)[zag] Формат Pod
+
+Jan 08th 2011(v0.5)[zag] Подпрограммы и сигнатуры
+
+=end CHANGES
+=for AUTHOR
+firstname: Александр
+surname: Загацкий
+
+=CHAPTER Test chpater
+
+Ok
+=end pod
+T
+
+my %res = ();
+my $sub = sub {
+ my $res = shift;
+ return sub {
+ my $node = shift;
+ my $name = $node->name;
+ if ($name =~ /^(CHANGES|SUBTITLE|AUTHOR|TITLE|DESCRIPTION)$/) {
+ $res->{$name} = $node ;
+ # warn $name;
+ }
+ return scalar( keys %{$res} ) == 5 # finish if we collect all headers
+ }
+};
+
+#warn $str;
+#diag Dumper \%res;
+
+
+
Please sign in to comment.
Something went wrong with that request. Please try again.