/[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 1133 - (show annotations)
Tue Jun 30 15:10:55 2009 UTC (14 years, 9 months ago) by dpavlin
File size: 2707 byte(s)
make classes immutable and remove moose droppings to make Perl::Critic::Moose happy
1 package Frey::Pipe;
2 use Moose;
3 extends 'Frey::Class::Loader';
4 with 'Frey::Web';
5
6 use lib 'lib';
7 use Frey::Action;
8
9 =head1 DESCRIPTION
10
11 Shell pipes for structured data
12
13 =head1 EXAMPLE
14
15 Frey::Feed/as_data + uri=https://blog.rot13.org/index.xml | Frey::View::Dumper/as_markup
16
17 this will produce following code:
18
19 Frey::View::Dumper->new( data =>
20 Frey::Feed->new( uri => 'https://blog.rot13.org/index.xml' )->as_data
21 )->as_markup
22
23 =cut
24
25 has pipe => (
26 is => 'rw',
27 required => 1,
28 default => 'Frey::Feed/as_data+uri=https://blog.rot13.org/index.xml|Frey::View::Dumper/as_markup',
29 );
30
31 sub render_pipe { 'radio' };
32
33 use Data::Dump qw/dump/;
34
35 sub as_markup {
36 my ($self) = @_;
37
38 my $out;
39 my $pipe;
40
41 $self->title( $self->pipe );
42
43 my @parts;
44
45 foreach my $part ( split(/\|/, $self->pipe ) ) {
46 warn "# part: '$part'";
47 if ( $part =~ m{^([^/]+)/([^\+\?]+)(.*)?$} ) {
48 my ( $class, $method, $args ) = ( $1, $2, $3 );
49 my $params = $pipe;
50 $params = {} unless defined $params;
51 if ( defined $args ) {
52 $args =~ s{^[\?\+\s]}{};
53 warn "# class $class method $method args '$args'", $pipe ? " pipe args " . join(',',keys %$pipe) : '' if $self->debug;
54 map {
55 my ( $name, $value ) = ( $1, $2 ) if m{^([^=]+)=(.+)$} || confess "can't parse '$_'";
56 $params->{$name} = $value;
57 } split(/&/, $args)
58 }
59
60 my ( $html, $default ) = Frey::Action->new( class => $class, params => $params )->params_form;
61 warn "$class need more params than ",dump( $default ) if $html && $self->debug; # FIXME replace with query
62
63 warn "# pipe $part" if $self->debug;
64 my $o = $self->new_frey_class( $class, $default );
65
66 # XXX copy depends from parts of pipe
67 if ( $o->can('depends') ) {
68 $o->depends;
69 my $current_head;
70 $current_head->{$_}++ foreach $self->head;
71 foreach ( $o->head ) {
72 next if $current_head->{$_}++;
73 $self->add_head( $_ );
74 }
75 }
76
77 my $result = $o->$method;
78 warn "# result ",length( $result ), " bytes ", ref($result);
79
80 my $current_status;
81 $current_status->{$_}++ foreach $self->status;
82 foreach ( $o->status ) {
83 next if $current_status->{$_}++;
84 $self->add_status( $_ );
85 warn "# pipe add_status: $_";
86 }
87
88 $self->content_type( $o->content_type ) if $o->can('content_type');
89
90 $out = $result;
91 $method =~ s{^as_}{};
92 $pipe = { $method => $result };
93 push @parts, { $class . '->' . $method => $result };
94 } else {
95 die "don't know what to do with '$part' from ",$self->pipe;
96 }
97 }
98
99 $pipe = $self->pipe;
100
101 $out = $self->error(
102 qq|<a href="$pipe" title="copy pipe"><tt>$pipe</tt></a> = $out not scalar\n|
103 . $self->html_dump($out)
104 ) if ref $out;
105
106 return $out;
107 }
108
109 __PACKAGE__->meta->make_immutable;
110 no Moose;
111
112 1;

  ViewVC Help
Powered by ViewVC 1.1.26