Browse files

first ever commit

  • Loading branch information...
0 parents commit c8d83d63964e1c62c9de9bbbed558ba6e5ab5fc5 @draegtun committed Nov 27, 2008
Showing with 1,163 additions and 0 deletions.
  1. +11 −0 .gitignore
  2. +18 −0 Build.PL
  3. +10 −0 Changes
  4. +18 −0 MANIFEST
  5. +11 −0 MANIFEST.SKIP
  6. +9 −0 MANIFEST.bak
  7. +29 −0 META.yml
  8. +15 −0 Makefile.PL
  9. +62 −0 README
  10. +8 −0 TODO
  11. +244 −0 lib/Builder.pm
  12. +110 −0 lib/Builder/Utils.pm
  13. +231 −0 lib/Builder/XML.pm
  14. +165 −0 lib/Builder/XML/Utils.pm
  15. +12 −0 t/00-load.t
  16. +53 −0 t/boilerplate.t
  17. +47 −0 t/builder_xml_basic.t
  18. +32 −0 t/builder_xml_cdata.t
  19. +48 −0 t/builder_xml_namespace.t
  20. +18 −0 t/pod-coverage.t
  21. +12 −0 t/pod.t
11 .gitignore
@@ -0,0 +1,11 @@
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+Builder-*
+cover_db
+.DS_Store
18 Build.PL
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+ module_name => 'Builder',
+ license => 'perl',
+ dist_author => 'Barry Walsh <draegtun@cpan.org>',
+ dist_version_from => 'lib/Builder.pm',
+ build_requires => {
+ 'Test::More' => 0,
+ 'Carp' => 0,
+ },
+ add_to_cleanup => [ 'Builder-*' ],
+ create_makefile_pl => 'traditional',
+);
+
+$builder->create_build_script();
10 Changes
@@ -0,0 +1,10 @@
+Revision history for Builder
+
+0.01 Weds November 26, 2008
+ * First ever version on CPAN
+ - Also my first ever CPAN module!
+ - Its a stripped back version as I get use to CPAN ropes
+ - Source code will be on GitHub (using git is also another first for me!)
+ - So will be merging back some newer changes from SVN over next few versions
+ - Including adding back in CSS module
+
18 MANIFEST
@@ -0,0 +1,18 @@
+Build.PL
+Changes
+lib/Builder.pm
+lib/Builder/Utils.pm
+lib/Builder/XML.pm
+lib/Builder/XML/Utils.pm
+MANIFEST
+README
+t/00-load.t
+t/boilerplate.t
+t/builder_xml_basic.t
+t/builder_xml_cdata.t
+t/builder_xml_namespace.t
+t/pod-coverage.t
+t/pod.t
+TODO
+Makefile.PL
+META.yml
11 MANIFEST.SKIP
@@ -0,0 +1,11 @@
+^\.gitignore$
+^\.git\b
+^\.DS_Store
+^_build
+^Build$
+^blib
+~$
+\.bak$
+\.old$
+^MANIFEST\.SKIP$
+CVS
9 MANIFEST.bak
@@ -0,0 +1,9 @@
+Build.PL
+Changes
+MANIFEST
+README
+lib/Builder.pm
+lib/Builder/XML.pm
+t/00-load.t
+t/pod-coverage.t
+t/pod.t
29 META.yml
@@ -0,0 +1,29 @@
+---
+name: Builder
+version: 0.01
+author:
+ - 'Barry Walsh <draegtun@cpan.org>'
+abstract: 'Build XML, HTML, CSS and other outputs in blocks'
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+build_requires:
+ Carp: 0
+ Test::More: 0
+provides:
+ Builder:
+ file: lib/Builder.pm
+ version: 0.01
+ Builder::Utils:
+ file: lib/Builder/Utils.pm
+ version: 0.01
+ Builder::XML:
+ file: lib/Builder/XML.pm
+ version: 0.01
+ Builder::XML::Utils:
+ file: lib/Builder/XML/Utils.pm
+ version: 0.01
+generated_by: Module::Build version 0.3
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
15 Makefile.PL
@@ -0,0 +1,15 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.30
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'PL_FILES' => {},
+ 'INSTALLDIRS' => 'site',
+ 'NAME' => 'Builder',
+ 'EXE_FILES' => [],
+ 'VERSION_FROM' => 'lib/Builder.pm',
+ 'PREREQ_PM' => {
+ 'Test::More' => 0,
+ 'Carp' => 0
+ }
+ )
+;
62 README
@@ -0,0 +1,62 @@
+Builder version 0.01
+
+This distribution includes the following modules:
+
+ Builder (0.01)
+ Builder::Utils (0.01)
+ Builder::XML (0.01)
+ Builder::XML::Utils (0.01)
+
+
+SYNOPSIS
+
+Using building blocks to render XML, CSS, HTML and other outputs.
+
+ use Builder;
+
+ my $builder = Builder->new();
+
+ my $xm = $builder->block( 'Builder::XML' );
+
+ $xm->body(
+ $xm->div( { id => 'mydiv' },
+ $xm->bold( 'hello' ),
+ $xm->em( 'world' )
+ );
+ );
+
+ say $builder->render;
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
+
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ Carp
+
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc Builder
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2008 Barry Walsh (Draegtun Systems Ltd)
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
8 TODO
@@ -0,0 +1,8 @@
+0.01
+ Finish off docs
+ Add more tests
+ Bring git (GitHub) up-to-date with latest version in my SVN
+ (NB. Above includes CSS module)
+ Add subs saving to Builder::XML (benchmark first)
+ Create Builder::HTML & Builder::HTML::Validated
+ Refactor! Refactor! Refactor!
244 lib/Builder.pm
@@ -0,0 +1,244 @@
+package Builder;
+use strict;
+use warnings;
+use Carp;
+our $VERSION = '0.01';
+
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $level = 0;
+ bless {
+ %args,
+ blocks => [],
+ stack => [],
+ level => sub { $level },
+ inc => sub { $level++ },
+ dec => sub { $level-- },
+ }, $class;
+}
+
+sub block {
+ my ( $self, $block, %args ) = @_;
+ eval "require $block";
+ return $self->_new_block( $block->__new__(
+ %args,
+ _output => $self->{output},
+ _inc => $self->{inc},
+ _dec => $self->{dec},
+ _level => $self->{level},
+ _block_id => $self->_block_id,
+ _stack => $self->{ stack }
+ ));
+}
+
+sub render {
+ my ( $self ) = @_;
+ my $render;
+
+ # loop thru return chain (DOM!)
+ while ( my $block = shift @{ $self->{ stack } } ) {
+ my ( $block_id, $code ) = @$block;
+ $render.= $code->();
+ }
+
+ return $render;
+}
+
+sub flush {
+ my ( $self ) = @_;
+ $self->{ stack } = [];
+}
+
+sub _block_id {
+ my ( $self ) = shift;
+ return scalar @{ $self->{blocks} };
+}
+
+sub _new_block {
+ my ( $self, $block ) = @_;
+ push @{ $self->{blocks} }, $block;
+ return $block;
+}
+
+
+1;
+
+__END__
+
+
+
+=head1 NAME
+
+Builder - Build XML, HTML, CSS and other outputs in blocks
+
+=head1 VERSION
+
+Version 0.01
+
+
+
+=head1 SYNOPSIS
+
+Example using just one building block (for now!)....
+
+ use Builder;
+
+
+ my $builder = Builder->new();
+
+ my $xm = $builder->block( 'Builder::XML' );
+
+
+ $xm->body(
+ $xm->div( { id => 'mydiv' },
+ $xm->bold( 'hello' ),
+ $xm->em( 'world' )
+ );
+ );
+
+
+ say $builder->render;
+
+
+ # will produce =>
+ # <body><div id="mydiv"><bold>hello</bold><em>world</em></div></body>
+
+
+
+=head1 DESCRIPTION
+
+TBD... add multiple blocks & sub (coderef) examples.
+
+TBD... add Builder non-OO example (once back in codebase!)
+
+
+=head1 EXPORT
+
+Nothing (at this moment!)
+
+
+=head1 METHODS
+
+=head2 new
+
+Constructor. Currently no args are used.
+
+ my $builder = Builder->new();
+
+
+=head2 block
+
+Create a block. First arg is the block to use, for eg. 'Builder::XML'. Second arg is a hashref (or it will be!)
+
+ my $builder = Builder->new();
+
+ my $xm = $builder->block( 'Builder::XML', cdata => 1 ); # v 0.01
+
+ my $xm = $builder->block( 'Builder::XML', { cdata => 1 } ); # v 0.02 onwards
+
+
+For options that can be passed as args please see relevant builder documentation.
+
+
+=head2 render
+
+Renders all the blocks for the requested builder stack returning the information.
+
+ my $output = $builder->render;
+
+=head2 flush
+
+The render method will automatically flush the builder stack. Unlikely this will be any use externally!
+
+ $builder->flush; # there goes all the blocks just built ;-(
+
+
+=head1 AUTHOR
+
+Barry Walsh C<< <draegtun at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-builder at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Builder>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+
+
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Builder
+
+
+You can also look for information at: http://github.com/draegtun/builder
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Builder>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Builder>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Builder>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Builder/>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+=over 4
+
+My main inspiration came primarily from Builder for Ruby L<http://builder.rubyforge.org/>
+ and also a little bit from Groovy Builders L<http://groovy.codehaus.org/Builders>
+
+=back
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item B<Other Builder::* modules>:
+
+L<Builder::XML>
+
+=item B<Similar CPAN modules>:
+
+L<Class::XML>, L<XML::Generator>
+
+=back
+
+=head2 Builder Source Code
+
+Can be (shortly!) found on GitHub at http://github.com/draegtun/builder/tree/master
+
+=head1 DISCLAIMER
+
+This is (near) beta software. I'll strive to make it better each and every day!
+
+However I accept no liability I<whatsoever> should this software do what you expected ;-)
+
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Barry Walsh (Draegtun Systems Ltd), all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+
+
110 lib/Builder/Utils.pm
@@ -0,0 +1,110 @@
+package Builder::Utils;
+use strict;
+use warnings;
+use Carp;
+our $VERSION = '0.01';
+
+
+# common utilities put here and not exported into Builder::* because it would pollute namespace (ie. tags!)
+
+sub yank (&\@) {
+ my ( $code, $array ) = @_;
+ my $index = 0;
+ my @return;
+
+ while ( $index <= $#{ $array } ) {
+ local $_ = $array->[ $index ];
+ if ( $code->() ) {
+ push @return, splice @$array, $index, 1;
+ }
+ else { $index++ }
+ }
+
+ return @return;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Builder::Utils - Internal Builder Utils
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+
+
+=head1 SYNOPSIS
+
+TBD
+
+=head1 EXPORT
+
+None.
+
+=head1 FUNCTIONS
+
+=head2 yank
+
+
+=head1 AUTHOR
+
+Barry Walsh C<< <draegtun at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-builder at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Builder>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+
+
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Builder::Utils
+
+
+You can also look for information at: L<Builder>
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Builder>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Builder>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Builder>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Builder/>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+See L<Builder>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Barry Walsh (Draegtun Systems Ltd), all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
231 lib/Builder/XML.pm
@@ -0,0 +1,231 @@
+package Builder::XML;
+use strict;
+use warnings;
+use Carp;
+use Builder::Utils;
+use Builder::XML::Utils;
+our $VERSION = '0.01';
+our $AUTOLOAD;
+
+
+sub __new__ {
+ my ( $class ) = shift;
+ my %args = Builder::XML::Utils::get_args( @_ );
+
+ bless {
+ %args,
+ block_id => $args{ _block_id },
+ stack => $args{ _stack },
+ context => Builder::XML::Utils::build_context(),
+ }, $class;
+}
+
+sub AUTOLOAD {
+ my ( $self ) = shift;
+ my @args = @_;
+
+ if ( $AUTOLOAD =~ /.*::(.*)/ ) {
+ my $elt = $1;
+ my $attr = undef;
+
+ # sub args get resent as callback
+ if ( wantarray ) {
+ return sub { $self->$elt( @args ) };
+ }
+
+ # if first arg is hasharray then its attributes!
+ $attr = shift @args if ref $args[0] eq 'HASH';
+
+ if ( ref $args[0] eq 'CODE' ) {
+ $self->__element__( context => 'start', element => $elt, attr => $attr );
+ for my $inner ( @args ) {
+ if ( ref $inner eq 'CODE' ) { $inner->() }
+ else { $self->__push__( sub { $inner } ) }
+ }
+ $self->__element__( context => 'end', element => $elt );
+ return;
+ }
+
+ # bog standard element
+ $self->__element__( element => $elt, attr => $attr, text => "@args" );
+ }
+
+ $self;
+}
+
+# TODO: look at XML::Element as alternative to my context method
+# Hmmm... XML::Element (& HTML::Element) doesnt have namespaces!? ;-(
+
+# TODO: So forget above!! But do look at...
+# 1. building subs (for speed). Lets do benchmarking before attempting this!
+# 2. XML::Entities (option to decode on reading data & to encode on way out)
+# 3. cdata - DONE
+# 4. Direct print option - Added to Builder.pm.. appears to work.. need to write test
+# 5. AUTOLOAD & DESTROY tags - solution?
+
+
+######################################################
+# methods
+
+# Todo: amend below to only work on local stack (block_id) - NB. makes it different to Builder->render then? Already Done?!
+sub __render__ {
+ my $self = shift;
+ my $render;
+
+ # render subs just for this block
+ my @this_block = Builder::Utils::yank { $_->[0] == $self->{block_id} } @{ $self->{stack} };
+ while ( my $block = shift @this_block ) {
+ my ( $block_id, $code ) = @$block;
+ $render.= $code->();
+ }
+ return $render;
+}
+
+sub __element__ {
+ my ( $self, %param ) = @_;
+ $param{ text } ||= '';
+ $param{ context } ||= 'element';
+ $self->{ context }->{ $param{ context } }->( $self, \%param );
+ return;
+}
+
+sub __cdata__ {
+ my $self = shift;
+ return $_[0] if $self->{ cdata } == 1;
+ return $self->__cdatax__( $_[0] );
+}
+
+sub __cdatax__ {
+ my $self = shift;
+ return q{<!CDATA[[} . $_[0] . q{]]>};
+}
+
+sub __say__ {
+ my ( $self, @say ) = @_;
+ for my $said ( @say ) { $self->__push__( sub { $said } ) }
+ return;
+}
+
+sub __push__ {
+ my ( $self, $code ) = @_;
+
+ # straight to output stream if provided
+ if ( $self->{ _output } ) {
+ print { $self->{ _output } } $code->();
+ return;
+ }
+
+ # else add to stack
+ push @{ $self->{ stack } }, [ $self->{ block_id }, $code ];
+}
+
+sub __inc__ { $_[0]->{ _inc }->() }
+
+sub __dec__ { $_[0]->{ _dec }->() }
+
+sub __level__ { $_[0]->{ _level }->() }
+
+sub __tab__ {
+ my $self = shift;
+ return q{ } x ( $self->{ indent } * $self->__level__ ) if $self->{ indent };
+ return q{};
+}
+
+
+
+sub DESTROY {
+ my $self = shift;
+ $self = undef;
+}
+
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+Builder::XML - Building block for XML
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+
+
+=head1 SYNOPSIS
+
+TBD
+
+
+=head1 EXPORT
+
+None.
+
+
+=head1 METHODS
+
+=head2 AUTOLOAD
+
+=head2 DESTORY
+
+
+=head1 AUTHOR
+
+Barry Walsh C<< <draegtun at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-builder at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Builder>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+
+
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Builder::XML
+
+
+You can also look for information at: L<Builder>
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Builder>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Builder>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Builder>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Builder/>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Barry Walsh (Draegtun Systems Ltd), all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+
+=cut
+
165 lib/Builder/XML/Utils.pm
@@ -0,0 +1,165 @@
+package Builder::XML::Utils;
+use strict;
+use warnings;
+use Carp;
+our $VERSION = '0.01';
+
+
+sub build_context {
+
+ my $context = {
+
+ 'start' => sub {
+ my ( $self, $param ) = @_;
+ my $tag = $self->{ns} . $param->{ element };
+ my $attr_ref = $param->{ attr };
+
+ $self->__push__( sub {
+ # start building the return string
+ my $return .= $self->__tab__ . q{<}.$tag;
+
+ # any spec attrs?
+ if ( $attr_ref->{ _xmlns_ } ) {
+ $return .= sprintf(' xmlns:%s="%s"', $self->{namespace}, $attr_ref->{ _xmlns_ } );
+ delete $attr_ref->{ _xmlns_ };
+ }
+
+ # build attributes string
+ for my $k ( keys %{ $attr_ref } ) {
+ $return .= sprintf( ' %s%s="%s"', $self->{attr_ns}, $k, $attr_ref->{$k} );
+ }
+
+ $return .= q{>} . $self->{cr};
+ $self->__inc__;
+
+ return $return;
+ });
+
+ },
+
+ 'end' => sub {
+ my ( $self, $param ) = @_;
+ my $tag = $self->{ns} . $param->{ element };
+
+ $self->__push__( sub {
+ $self->__dec__;
+ $self->__tab__ . q{</}.$tag.q{>} . $self->{cr}
+ });
+ },
+
+ 'element' => sub {
+ my ( $self, $param ) = @_;
+ my $tag = $self->{ns} . $param->{ element };
+ my $text = $param->{text};
+ $text = $self->__cdatax__( $text ) if $self->{ cdata };
+
+ my $attrib = q{};
+ for my $k ( keys %{ $param->{ attr } } ) {
+ $attrib .= sprintf( ' %s%s="%s"', $self->{attr_ns}, $k, $param->{attr}->{$k} );
+ }
+
+ $self->__push__( sub {
+ $self->__tab__ . q{<}.$tag.$attrib.q{>}.$text.q{</}.$tag.q{>} . $self->{cr}
+ });
+ },
+ };
+
+ return $context;
+}
+
+
+sub get_args {
+ my ( %arg ) = @_;
+ $arg{ns} = defined $arg{namespace} ? $arg{namespace} . q{:} : q{};
+ $arg{attr_ns} = defined $arg{attr_namespace} ? ( $arg{attr_namespace} . ':' ) : q{};
+ $arg{attr_ns} = $arg{qualifiedAttrib} ? $arg{ns} : $arg{attr_ns};
+ $arg{cr} = $arg{ newline } ? "\n" : q{};
+ $arg{cdata} ||= 0;
+ return %arg;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Builder::XML::Utils - Internal Builder XML Utils
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+
+
+=head1 SYNOPSIS
+
+TBD
+
+=head1 EXPORT
+
+None.
+
+=head1 FUNCTIONS
+
+=head2 build_context
+
+=head2 get_args
+
+
+=head1 AUTHOR
+
+Barry Walsh C<< <draegtun at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-builder at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Builder>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+
+
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Builder::XML::Utils
+
+
+You can also look for information at: L<Builder>
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Builder>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Builder>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Builder>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Builder/>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+See L<Builder>
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Barry Walsh (Draegtun Systems Ltd), all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
12 t/00-load.t
@@ -0,0 +1,12 @@
+#!perl -T
+
+use Test::More tests => 4;
+
+BEGIN {
+ use_ok( 'Builder' );
+ use_ok( 'Builder::Utils' );
+ use_ok( 'Builder::XML' );
+ use_ok( 'Builder::XML::Utils' );
+}
+
+diag( "Testing Builder $Builder::VERSION, Perl $], $^X" );
53 t/boilerplate.t
@@ -0,0 +1,53 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+sub not_in_file_ok {
+ my ($filename, %regex) = @_;
+ open( my $fh, '<', $filename )
+ or die "couldn't open $filename for reading: $!";
+
+ my %violated;
+
+ while (my $line = <$fh>) {
+ while (my ($desc, $regex) = each %regex) {
+ if ($line =~ $regex) {
+ push @{$violated{$desc}||=[]}, $.;
+ }
+ }
+ }
+
+ if (%violated) {
+ fail("$filename contains boilerplate text");
+ diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+ } else {
+ pass("$filename contains no boilerplate text");
+ }
+}
+
+sub module_boilerplate_ok {
+ my ($module) = @_;
+ not_in_file_ok($module =>
+ 'the great new $MODULENAME' => qr/ - The great new /,
+ 'boilerplate description' => qr/Quick summary of what the module/,
+ 'stub function definition' => qr/function[12]/,
+ );
+}
+
+
+not_in_file_ok(README =>
+"The README is used..." => qr/The README is used/,
+"'version information here'" => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+"placeholder date/time" => qr(Date/time)
+);
+
+module_boilerplate_ok('lib/Builder.pm');
+module_boilerplate_ok('lib/Builder/Utils.pm');
+module_boilerplate_ok('lib/Builder/XML.pm');
+module_boilerplate_ok('lib/Builder/XML/Utils.pm');
+
47 t/builder_xml_basic.t
@@ -0,0 +1,47 @@
+use Test::More tests => 3;
+use Builder;
+
+my $builder = Builder->new();
+my $xm = $builder->block( 'Builder::XML' );
+
+my $expected = q{<body><em>emphasized</em><div id="mydiv"><bold>hello</bold><em>world</em></div></body>};
+
+# test 1
+$xm->body( sub {
+ $xm->em("emphasized");
+ $xm->div( { id => 'mydiv' }, $xm->bold('hello'), $xm->em('world') );
+});
+
+is $builder->render, $expected, "xml test 1 failed";
+
+
+# test 2
+$xm->body(
+ $xm->em("emphasized"),
+ $xm->div( { id => 'mydiv' }, sub {
+ $xm->bold('hello'); $xm->em('world');
+ }),
+);
+
+is $builder->render, $expected, "xml test 2 failed";
+
+
+# test 3
+$xm->test('hello');
+my $zz = $builder->render;
+
+$xm->body( sub {
+ $xm->em("emphasized");
+ $xm->div( { id => 'mydiv' },
+ $xm->bold('hello'),
+ $xm->em('world'),
+ $zz,
+ $xm->div( sub {
+ $xm->p('para');
+ $xm->__say__($zz);
+ }),
+ );
+});
+
+$expected = q{<body><em>emphasized</em><div id="mydiv"><bold>hello</bold><em>world</em><test>hello</test><div><p>para</p><test>hello</test></div></div></body>};
+is $builder->render, $expected, "xml test 3 failed";
32 t/builder_xml_cdata.t
@@ -0,0 +1,32 @@
+use Test::More tests => 2;
+use Builder;
+
+my $builder = Builder->new();
+my $with_cdata = $builder->block( 'Builder::XML', cdata => 1 );
+my $without_cdata = $builder->block( 'Builder::XML' );
+my $text = "Tom, Dick & Harry";
+my $text2 = lc $text;
+
+# test 1
+$with_cdata->body( sub {
+ $with_cdata->span($text);
+ $with_cdata->span( $with_cdata->__cdata__( $text2 ) );
+});
+is $builder->render, data("<!CDATA[[$text]]>", $text2), "xml cdata test 1";
+
+# test 2
+$without_cdata->body( sub {
+ $without_cdata->span($text);
+ $without_cdata->span( $without_cdata->__cdata__( $text2 ) );
+});
+is $builder->render, data($text, $text2), "xml cdata test 2";
+
+sub data {
+ return qq{<body><span>$_[0]</span><span><!CDATA[[$_[1]]]></span></body>};
+}
+
+
+__END__
+
+ '<body><span><!CDATA[[Tom, Dick & Harry]]></span><span><!CDATA[[<!CDATA[[tom, dick & harry]]>]]></span></body>'
+ '<body><span><!CDATA[[Tom, Dick & Harry]]></span><span><!CDATA[[tom, dick & harry]]></span></body>'
48 t/builder_xml_namespace.t
@@ -0,0 +1,48 @@
+use Test::More tests => 4;
+use Builder;
+
+my $builder = Builder->new();
+my $xm = $builder->block( 'Builder::XML', namespace => 'foo', qualifiedAttrib => 0 );
+
+my $expected = q{<foo:body><foo:em>emphasized</foo:em><foo:div id="mydiv"><foo:bold>hello</foo:bold><foo:em>world</foo:em></foo:div></foo:body>};
+
+# test 1
+$xm->body( sub {
+ $xm->em("emphasized");
+ $xm->div( { id => 'mydiv' }, $xm->bold('hello'), $xm->em('world') );
+});
+
+is $builder->render, $expected, "xml test 1";
+
+# test2
+my $xm2 = $builder->block( 'Builder::XML', namespace => 'foo', qualifiedAttrib => 1 );
+$expected = q{<foo:body><foo:em>emphasized</foo:em><foo:div foo:id="mydiv"><foo:bold>hello</foo:bold><foo:em>world</foo:em></foo:div></foo:body>};
+
+$xm2->body( sub {
+ $xm2->em("emphasized");
+ $xm2->div( { id => 'mydiv' }, $xm2->bold('hello'), $xm2->em('world') );
+});
+
+is $builder->render, $expected, "xml test 2";
+
+
+# test 3
+$expected = q{<foo:body xmlns:foo="http://www.w3.org/TR/REC-html40"><foo:em>emphasized</foo:em><foo:div id="mydiv"><foo:bold>hello</foo:bold><foo:em>world</foo:em></foo:div></foo:body>};
+$xm->body( { _xmlns_ => "http://www.w3.org/TR/REC-html40" },
+ sub {
+ $xm->em("emphasized");
+ $xm->div( { id => 'mydiv' }, $xm->bold('hello'), $xm->em('world') );
+});
+
+is $builder->render, $expected, "xml test 3";
+
+
+# test 4
+$expected = q{<foo:body xmlns:foo="http://www.w3.org/TR/REC-html40"><foo:em>emphasized</foo:em><foo:div foo:id="mydiv"><foo:bold>hello</foo:bold><foo:em>world</foo:em></foo:div></foo:body>};
+$xm2->body( { _xmlns_ => "http://www.w3.org/TR/REC-html40" },
+ sub {
+ $xm2->em("emphasized");
+ $xm2->div( { id => 'mydiv' }, $xm2->bold('hello'), $xm2->em('world') );
+});
+
+is $builder->render, $expected, "xml test 4";
18 t/pod-coverage.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
+ if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
+ if $@;
+
+all_pod_coverage_ok();
12 t/pod.t
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();

0 comments on commit c8d83d6

Please sign in to comment.