/[Frey]/trunk/lib/Frey/Shell/Grep.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/Shell/Grep.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 732 - (show annotations)
Sat Dec 6 00:26:12 2008 UTC (15 years, 4 months ago) by dpavlin
File size: 2393 byte(s)
simple two step action as still non-working prototype
1 package Frey::Shell::Grep;
2 use Moose;
3
4 extends 'Frey';
5 with 'Frey::Web';
6
7 use English;
8
9 has pattern => (
10 documentation => 'grep pattern',
11 is => 'rw',
12 isa => 'Str',
13 required => 1,
14 default => 'FIXME',
15 );
16
17 has path => (
18 documentation => 'path(s) to grep',
19 is => 'rw',
20 isa => 'Str',
21 required => 1,
22 default => 'lib/ t/ etc/',
23 );
24
25 has _grep_command => (
26 documentation => 'executed grep command',
27 is => 'rw',
28 isa => 'Str',
29 );
30
31 has results_as_data => (
32 is => 'rw',
33 isa => 'ArrayRef[HashRef]',
34 lazy => 1,
35 default =>
36 sub {
37
38 my ($self) = @_;
39
40 my $patt = $self->pattern;
41
42 my $cmd = 'grep -rn ' . $patt . ' ' . $self->path;
43 $self->_grep_command( $cmd );
44 warn "# $cmd";
45
46 my @results;
47
48 open(my $fh, '-|', $cmd) || die "can't open pipe to $cmd $!";
49 while(<$fh>) {
50 my ( $path, $line, $text ) = split(/:/,$_,3);
51 if ( ! $line ) {
52 push @results, { text => $path };
53 } else {
54 push @results, { path => $path, line => $line, text => $text };
55 }
56 }
57
58 if ( $INPUT_LINE_NUMBER > 0 ) { # closing pipe grep output results in error
59 close($fh) || die "can't close pipe to $cmd $!";
60 }
61
62 # warn "# ", $self->dump( @results );
63
64 return \@results;
65 });
66
67 sub as_markup {
68 my $self = shift;
69 my $callback = {@_};
70
71 my $patt = $self->pattern;
72 $self->title( $patt );
73
74 $self->add_css(qq|
75 dt.p {
76 color: #888;
77 white-space: pre-wrap;
78 font-family: monospace;
79 margin-top: 1em;
80 }
81 dd a {
82 float: left;
83 width: 3em;
84 }
85 dd code b {
86 background-color: #ff8;
87 }
88 |);
89
90 my $html;
91 my $last_path = '';
92
93 foreach my $result ( @{ $self->results_as_data } ) {
94
95 warn $self->dump( $result );
96
97 my $text = $result->{text} || die "no text";
98
99 $text = $self->html_escape( $text );
100 if ( my $path = $result->{path} ) {
101 my $line = $result->{line} || die "no line";
102 if ( $path ne $last_path ) {
103 $html .= qq|<dt class="p">$path</dt>|;
104 }
105 if ( my $dd = $callback->{dd} ) {
106 $html .= $dd->( $patt, $path, $line, $text );
107 } else {
108 $text =~ s{(\Q$patt\E)}{<b>$1</b>};
109 $html .= qq|<dd><a target="editor" href="/editor+$path+$line">$line</a> <code>$text</code>|;
110 }
111 $last_path = $path;
112 } else {
113 $html .= qq|<dt>$text</dt>|;
114 }
115 }
116
117 if ( $html ) {
118 my $command = $self->_grep_command;
119 $html = qq|
120 <h1>$patt</h1>
121 <pre>$command</pre>
122 <dl>$html</dl>
123 |;
124 } else {
125 $html = $self->error( "No results for $patt\n" );
126 }
127
128 return $html;
129 }
130
131 1;

  ViewVC Help
Powered by ViewVC 1.1.26