/[Frey]/trunk/lib/Frey/Pipe.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/lib/Frey/Pipe.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 401 - (show annotations)
Tue Nov 18 02:17:06 2008 UTC (15 years, 4 months ago) by dpavlin
File size: 1920 byte(s)
push pipe stages into status
1 package Frey::Pipe;
2 use Moose;
3 extends 'Frey';
4 with 'Frey::Web';
5
6 use Frey::Action;
7
8 =head1 DESCRIPTION
9
10 Shell pipes for structured data
11
12 =head1 EXAMPLE
13
14 Frey::Feed/data + uri=https://blog.rot13.org/index.xml | Frey::Dumper/markup
15
16 this will produce following code:
17
18 Frey::Dumper->new( data =>
19 Frey::Feed->new( uri => 'https://blog.rot13.org/index.xml' )->data
20 )->markup
21
22 =cut
23
24 has pipe => (
25 is => 'rw',
26 required => 1,
27 default => 'Frey::Feed/data+uri=https://blog.rot13.org/index.xml|Frey::Dumper/markup',
28 );
29
30 use Data::Dump qw/dump/;
31
32 sub markup {
33 my ($self) = @_;
34
35 my $out;
36 my $pipe;
37
38 foreach my $part ( split(/\|/, $self->pipe ) ) {
39 warn "# part: '$part'";
40 if ( $part =~ m{^([^/]+)/([^\+\?]+)(.*)?$} ) {
41 my ( $class, $method, $args ) = ( $1, $2, $3 );
42 my $params = $pipe;
43 $params = {} unless defined $params;
44 if ( defined $args ) {
45 $args =~ s{^[\?\+\s]}{};
46 warn "# class $class method $method args '$args'", $pipe ? " pipe args " . join(',',keys %$pipe) : '' if $self->debug;
47 push @{ $self->status }, { $class =>$args };
48 map {
49 my ( $name, $value ) = ( $1, $2 ) if m{^([^=]+)=(.+)$} || confess "can't parse '$_'";
50 $params->{$name} = $value;
51 } split(/\s*\+\s/, $args)
52 }
53
54 my ( $html, $default ) = Frey::Action->new( class => $class, params => $params )->params_form;
55 warn "$class need more params than ",dump( $default ) if $html; # FIXME replace with query
56
57 my $code = '$result = ' . $class . '->new' . dump( %$default ) . '->' . $method . '();';
58 warn "# pipe $part -> $code";
59 my $result;
60 eval $code;
61 die $@ if $@;
62 warn "# result ",ref( $result );
63 # $out .= qq{<span class="frey-popdown">$part<code>} . dump( $result ) . '</code><span><hr>';
64 $out = $result;
65 $pipe = { $method => $result };
66 } else {
67 die "don't know what to do with '$part' from ",$self->pipe;
68 }
69 }
70
71 return '<code>' . $self->pipe . '</code>' . $out;
72 }
73
74 1;

  ViewVC Help
Powered by ViewVC 1.1.26