/[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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.26