From: Matt S Trout Date: Thu, 18 Feb 2010 05:33:54 +0000 (+0000) Subject: introduce ZConfig system, first cut at HTML::Zoom itself X-Git-Tag: release_0.009004~74 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FHTML-Zoom.git;a=commitdiff_plain;h=d80786d07e9746f71b9b93554ce38f62ad1787e6 introduce ZConfig system, first cut at HTML::Zoom itself --- diff --git a/lib/HTML/Zoom.pm b/lib/HTML/Zoom.pm new file mode 100644 index 0000000..3234576 --- /dev/null +++ b/lib/HTML/Zoom.pm @@ -0,0 +1,188 @@ +package HTML::Zoom; + +use strict; +use warnings FATAL => 'all'; + +use HTML::Zoom::ZConfig; +use HTML::Zoom::MatchWithoutFilter; + +sub new { + my ($class, $args) = @_; + my $new = {}; + $new->{zconfig} = HTML::Zoom::ZConfig->new($args->{zconfig}||{}); + bless($new, $class); +} + +sub zconfig { shift->_self_or_new->{zconfig} } + +sub _self_or_new { + ref($_[0]) ? $_[0] : $_[0]->new +} + +sub _with { + bless({ %{$_[0]}, %{$_[1]} }, ref($_[0])); +} + +sub from_html { + my $self = shift->_self_or_new; + $self->_with({ + initial_events => $self->zconfig->parser->html_to_events($_[0]) + }); +} + +sub to_stream { + my $self = shift; + die "No events to build from - forgot to call from_html?" + unless $self->{initial_events}; + my $sutils = $self->zconfig->stream_utils; + my $stream = $sutils->stream_from_array(@{$self->{initial_events}}); + foreach my $filter_spec (@{$self->{filters}||[]}) { + $stream = $sutils->wrap_with_filter($stream, @{$filter_spec}); + } + $stream +} + +sub to_html { + my $self = shift; + $self->zconfig->producer->html_from_stream($self->to_stream); +} + +sub memoize { + my $self = shift; + ref($self)->new($self)->from_html($self->to_html); +} + +sub with_filter { + my ($self, $selector, $filter) = @_; + my $match = $self->parse_selector($selector); + $self->_with({ + filters => [ @{$self->{filters}||[]}, [ $match, $filter ] ] + }); +} + +sub select { + my ($self, $selector) = @_; + my $match = $self->parse_selector($selector); + return HTML::Zoom::MatchWithoutFilter->construct( + $self, $match, $self->zconfig->filter_builder, + ); +} + +# There's a bug waiting to happen here: if you do something like +# +# $zoom->select('.foo') +# ->remove_attribute({ class => 'foo' }) +# ->then +# ->well_anything_really +# +# the second action won't execute because it doesn't match anymore. +# Ideally instead we'd merge the match subs but that's more complex to +# implement so I'm deferring it for the moment. + +sub then { + my $self = shift; + die "Can't call ->then without a previous filter" + unless $self->{filters}; + $self->select($self->{filters}->[-1][0]); +} + +sub parse_selector { + my ($self, $selector) = @_; + return $selector if ref($selector); # already a match sub + $self->zconfig->selector_parser->parse_selector($selector); +} + +1; + +=head1 NAME + +HTML::Zoom - selector based streaming template engine + +=head1 SYNOPSIS + + use HTML::Zoom; + + my $template = < + + Hello people + + +

Placeholder

+ +

Name: Bob

Age: 23

+ +

+ + + HTML + + my $output = HTML::Zoom + ->from_html($template) + ->select('title, #greeting')->replace_content('Hello world & dog!') + ->select('#list')->repeat_content( + [ + sub { + $_->select('.name')->replace_content('Matt') + ->select('.age')->replace_content('26') + }, + sub { + $_->select('.name')->replace_content('Mark') + ->select('.age')->replace_content('0x29') + }, + sub { + $_->select('.name')->replace_content('Epitaph') + ->select('.age')->replace_content('') + }, + ], + { repeat_between => '.between' } + ) + ->to_html; + +will produce: + +=begin testinfo + + my $expect = < + + Hello world & dog! + + +

Hello world & dog!

+ +

Name: Matt

Age: 26

+ +

Name: Mark

Age: 0x29

+ +

Name: Epitaph

Age: <redacted>

+ + +

+ + + +=begin testinfo + + HTML + is($output, $expect, 'Synopsis code works ok'); + +=end testinfo + +=head1 SOMETHING ELSE + +=cut diff --git a/lib/HTML/Zoom/CodeStream.pm b/lib/HTML/Zoom/CodeStream.pm index 2232f28..1d70a58 100644 --- a/lib/HTML/Zoom/CodeStream.pm +++ b/lib/HTML/Zoom/CodeStream.pm @@ -14,7 +14,7 @@ sub from_array { sub new { my ($class, $args) = @_; - bless({ _code => $args->{code} }, $class); + bless({ _code => $args->{code}, _zconfig => $args->{zconfig} }, $class); } sub next { diff --git a/lib/HTML/Zoom/FilterBuilder.pm b/lib/HTML/Zoom/FilterBuilder.pm index d6dcb40..bdfb920 100644 --- a/lib/HTML/Zoom/FilterBuilder.pm +++ b/lib/HTML/Zoom/FilterBuilder.pm @@ -2,41 +2,23 @@ package HTML::Zoom::FilterBuilder; use strict; use warnings FATAL => 'all'; +use base qw(HTML::Zoom::SubObject); use HTML::Zoom::CodeStream; -sub new { bless({}, shift) } - sub _stream_from_code { - HTML::Zoom::CodeStream->new({ code => $_[1] }) + shift->_zconfig->stream_utils->stream_from_code(@_) } sub _stream_from_array { - shift; # lose $self - HTML::Zoom::CodeStream->from_array(@_) + shift->_zconfig->stream_utils->stream_from_array(@_) } sub _stream_from_proto { - my ($self, $proto) = @_; - my $ref = ref $proto; - if (not $ref) { - require HTML::Zoom::Parser::BuiltIn; - return $self->_stream_from_array({ - type => 'TEXT', - raw => HTML::Zoom::Parser::BuiltIn->html_escape($proto) - }); - } elsif ($ref eq 'ARRAY') { - return $self->_stream_from_array(@$proto); - } elsif ($ref eq 'CODE') { - return $proto->(); - } elsif ($ref eq 'SCALAR') { - require HTML::Zoom::Parser::BuiltIn; - return HTML::Zoom::Parser::BuiltIn->html_to_stream($$proto); - } - die "Don't know how to turn $proto (ref $ref) into a stream"; + shift->_zconfig->stream_utils->stream_from_proto(@_) } sub _stream_concat { - shift->_stream_from_array(@_)->flatten; + shift->_zconfig->stream_utils->stream_concat(@_) } sub set_attribute { @@ -106,7 +88,7 @@ sub collect { my $name = $evt->{name}; my $depth = 1; my $_next = $content ? 'peek' : 'next'; - $stream = $filter->($stream) if $filter; + $stream = do { local $_ = $stream; $filter->($stream) } if $filter; my $collector = $self->_stream_from_code(sub { return unless $stream; while (my ($evt) = $stream->$_next) { @@ -218,16 +200,8 @@ sub repeat { my @between; my $repeat_between = delete $options->{repeat_between}; if ($repeat_between) { - require HTML::Zoom::SelectorParser; - require HTML::Zoom::FilterStream; - my $sp = HTML::Zoom::SelectorParser->new; - my $filter = $self->collect({ into => \@between }); $options->{filter} = sub { - HTML::Zoom::FilterStream->new({ - stream => $_[0], - match => $sp->parse_selector($repeat_between), - filter => $filter - }) + $_->select($repeat_between)->collect({ into => \@between }) }; } my $repeater = sub { diff --git a/lib/HTML/Zoom/FilterStream.pm b/lib/HTML/Zoom/FilterStream.pm index ecab5df..e6d7a83 100644 --- a/lib/HTML/Zoom/FilterStream.pm +++ b/lib/HTML/Zoom/FilterStream.pm @@ -11,6 +11,7 @@ sub new { _stream => $args->{stream}, _match => $args->{match}, _filter => $args->{filter}, + _zconfig => $args->{zconfig}, }, $class ); diff --git a/lib/HTML/Zoom/MatchWithoutFilter.pm b/lib/HTML/Zoom/MatchWithoutFilter.pm new file mode 100644 index 0000000..a645586 --- /dev/null +++ b/lib/HTML/Zoom/MatchWithoutFilter.pm @@ -0,0 +1,26 @@ +package HTML::Zoom::MatchWithoutFilter; + +use strict; +use warnings FATAL => 'all'; + +sub construct { + bless({ + zoom => $_[1], match => $_[2], fb => $_[3], + }, $_[0]); +} + +sub DESTROY {} + +sub AUTOLOAD { + my $meth = our $AUTOLOAD; + $meth =~ s/.*:://; + my $self = shift; + if (my $cr = $self->{fb}->can($meth)) { + return $self->{zoom}->with_filter( + $self->{match}, $self->{fb}->$cr(@_) + ); + } + die "Filter builder ${\$self->{fb}} does not provide action ${meth}"; +} + +1; diff --git a/lib/HTML/Zoom/Parser/BuiltIn.pm b/lib/HTML/Zoom/Parser/BuiltIn.pm index 30da5d6..ba6f41a 100644 --- a/lib/HTML/Zoom/Parser/BuiltIn.pm +++ b/lib/HTML/Zoom/Parser/BuiltIn.pm @@ -2,19 +2,19 @@ package HTML::Zoom::Parser::BuiltIn; use strict; use warnings FATAL => 'all'; - -use HTML::Zoom::CodeStream; +use base qw(HTML::Zoom::SubObject); sub html_to_events { - my ($class, $text) = @_; + my ($self, $text) = @_; my @events; _hacky_tag_parser($text => sub { push @events, $_[0] }); return \@events; } sub html_to_stream { - my ($class, $text) = @_; - return HTML::Zoom::CodeStream->from_array(@{$class->html_to_events($text)}); + my ($self, $text) = @_; + return $self->_zconfig->stream_utils + ->stream_from_array(@{$self->html_to_events($text)}); } sub _hacky_tag_parser { diff --git a/lib/HTML/Zoom/Producer/BuiltIn.pm b/lib/HTML/Zoom/Producer/BuiltIn.pm index fb869ee..071d3d5 100644 --- a/lib/HTML/Zoom/Producer/BuiltIn.pm +++ b/lib/HTML/Zoom/Producer/BuiltIn.pm @@ -3,6 +3,10 @@ package HTML::Zoom::Producer::BuiltIn; use strict; use warnings FATAL => 'all'; +sub new { bless({}, $_[0]) } + +sub with_zconfig { shift } + sub html_from_stream { my ($class, $stream) = @_; my $html; diff --git a/lib/HTML/Zoom/StreamBase.pm b/lib/HTML/Zoom/StreamBase.pm index 3df8a81..a76a636 100644 --- a/lib/HTML/Zoom/StreamBase.pm +++ b/lib/HTML/Zoom/StreamBase.pm @@ -2,6 +2,9 @@ package HTML::Zoom::StreamBase; use strict; use warnings FATAL => 'all'; +use HTML::Zoom::MatchWithoutFilter; + +sub _zconfig { shift->{_zconfig} } sub peek { my ($self) = @_; @@ -53,4 +56,24 @@ sub map { }); } +sub with_filter { + my ($self, $selector, $filter) = @_; + my $match = $self->_parse_selector($selector); + $self->_zconfig->stream_utils->wrap_with_filter($self, $match, $filter); +} + +sub select { + my ($self, $selector) = @_; + my $match = $self->_parse_selector($selector); + return HTML::Zoom::MatchWithoutFilter->construct( + $self, $match, $self->_zconfig->filter_builder, + ); +} + +sub _parse_selector { + my ($self, $selector) = @_; + return $selector if ref($selector); # already a match sub + $self->_zconfig->selector_parser->parse_selector($selector); +} + 1; diff --git a/lib/HTML/Zoom/StreamUtils.pm b/lib/HTML/Zoom/StreamUtils.pm new file mode 100644 index 0000000..fcd341c --- /dev/null +++ b/lib/HTML/Zoom/StreamUtils.pm @@ -0,0 +1,59 @@ +package HTML::Zoom::StreamUtils; + +use strict; +use warnings FATAL => 'all'; +use base qw(HTML::Zoom::SubObject); + +use HTML::Zoom::CodeStream; +use HTML::Zoom::FilterStream; + +sub stream_from_code { + my ($self, $code) = @_; + HTML::Zoom::CodeStream->new({ + code => $code, + zconfig => $self->_zconfig, + }) +} + +sub stream_from_array { + my $self = shift; + my @array = @_; + $self->stream_from_code(sub { + return unless @array; + return shift @array; + }); +} + +sub stream_concat { + shift->stream_from_array(@_)->flatten; +} + +sub stream_from_proto { + my ($self, $proto) = @_; + my $ref = ref $proto; + if (not $ref) { + return $self->stream_from_array({ + type => 'TEXT', + raw => $self->_zconfig->parser->html_escape($proto) + }); + } elsif ($ref eq 'ARRAY') { + return $self->stream_from_array(@$proto); + } elsif ($ref eq 'CODE') { + return $proto->(); + } elsif ($ref eq 'SCALAR') { + return $self->_zconfig->parser->html_to_stream($$proto); + } + die "Don't know how to turn $proto (ref $ref) into a stream"; +} + +sub wrap_with_filter { + my ($self, $stream, $match, $filter) = @_; + HTML::Zoom::FilterStream->new({ + stream => $stream, + match => $match, + filter => $filter, + zconfig => $self->_zconfig, + }) +} + +1; diff --git a/lib/HTML/Zoom/SubObject.pm b/lib/HTML/Zoom/SubObject.pm new file mode 100644 index 0000000..3620e26 --- /dev/null +++ b/lib/HTML/Zoom/SubObject.pm @@ -0,0 +1,27 @@ +package HTML::Zoom::SubObject; + +use strict; +use warnings FATAL => 'all'; +use Scalar::Util (); + +sub new { + my ($class, $args) = @_; + ($args||={})->{zconfig} ||= do { + require HTML::Zoom::ZConfig; + HTML::Zoom::ZConfig->new + }; + my $new = { _zconfig => $args->{zconfig} }; + Scalar::Util::weaken($new->{_zconfig}); + bless($new, $class) +} + +sub _zconfig { shift->{_zconfig} } + +sub with_zconfig { + my ($self, $zconfig) = @_; + my $new = bless({ %$self, _zconfig => $zconfig }, ref($self)); + Scalar::Util::weaken($new->{_zconfig}); + $new +} + +1; diff --git a/lib/HTML/Zoom/ZConfig.pm b/lib/HTML/Zoom/ZConfig.pm new file mode 100644 index 0000000..9cf060b --- /dev/null +++ b/lib/HTML/Zoom/ZConfig.pm @@ -0,0 +1,39 @@ +package HTML::Zoom::ZConfig; + +use strict; +use warnings FATAL => 'all'; + +my %DEFAULTS = ( + parser => 'HTML::Zoom::Parser::BuiltIn', + producer => 'HTML::Zoom::Producer::BuiltIn', + filter_builder => 'HTML::Zoom::FilterBuilder', + selector_parser => 'HTML::Zoom::SelectorParser', + stream_utils => 'HTML::Zoom::StreamUtils', +); + +my $ALL_DEFAULT; + +sub new { + my ($class, $args) = @_; + return $ALL_DEFAULT if $ALL_DEFAULT && !keys %{$args||{}}; + my $new = {}; + foreach my $arg_name (keys %DEFAULTS) { + $new->{$arg_name} = $args->{$arg_name} || $DEFAULTS{$arg_name}; + if (ref($new->{$arg_name})) { + $new->{$arg_name} = $new->{$arg_name}->with_zconfig($new); + } else { + require(do { (my $m = $new->{$arg_name}) =~ s/::/\//g; "${m}.pm" }); + $new->{$arg_name} = $new->{$arg_name}->new({ zconfig => $new }); + } + } + $ALL_DEFAULT = $new if !keys %{$args||{}}; + bless($new, $class); +} + +sub parser { shift->{parser} } +sub producer { shift->{producer} } +sub filter_builder { shift->{filter_builder} } +sub selector_parser { shift->{selector_parser} } +sub stream_utils { shift->{stream_utils} } + +1; diff --git a/maint/synopsis-extractor b/maint/synopsis-extractor new file mode 100755 index 0000000..7c72d5b --- /dev/null +++ b/maint/synopsis-extractor @@ -0,0 +1,22 @@ +#!/usr/bin/env perl + +use strict; +use warnings FATAL => 'all'; + +my $from = do { local (@ARGV, $/) = ('lib/HTML/Zoom.pm'); <> }; + +$from =~ s/.*^=head1 SYNOPSIS\n//sm; + +$from =~ s/^=head1.*//sm; + +my $code = join "\n", map { s/^ // ? ($_) : () } split "\n", $from; + +open my $syn_test, '>', 't/synopsis.t' + or die "Couldn't open t/synopsis.t - you screwed something up. Go fix it.\n"; + +print $syn_test "use strict; +use warnings FATAL => 'all'; +use Test::More qw(no_plan); + +$code; +"; diff --git a/t/actions.t b/t/actions.t index 1267bd3..5e9bf16 100644 --- a/t/actions.t +++ b/t/actions.t @@ -18,9 +18,9 @@ my $tmpl = < END -sub src_stream { HTML::Zoom::Parser::BuiltIn->html_to_stream($tmpl); } +sub src_stream { HTML::Zoom::Parser::BuiltIn->new->html_to_stream($tmpl); } -sub html_sink { HTML::Zoom::Producer::BuiltIn->html_from_stream($_[0]) } +sub html_sink { HTML::Zoom::Producer::BuiltIn->new->html_from_stream($_[0]) } my $fb = HTML::Zoom::FilterBuilder->new;