/[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 377 - (hide annotations)
Mon Nov 17 17:55:50 2008 UTC (15 years, 5 months ago) by dpavlin
File size: 1737 byte(s)
implement ? as optional first delimiter to make it look more like URLs
and display pipe on top of output. Parametars can now embed spaces
(needed for SQL queries for example)
1 dpavlin 300 package Frey::Pipe;
2     use Moose;
3    
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     warn "# class $class method $method args '$args'", $pipe ? " pipe args " . join(',',keys %$pipe) : '';
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 368 my $default = $self->config( $class );
50     foreach my $arg ( keys %$default ) {
51     $params->{$arg} = $default->{$arg} if ! $params->{$arg};
52     }
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