root/examples/colordiff.pl

Revision 12318, 1.8 kB (checked in by polettix, 2 years ago)

[examples/colordiff.pl] Adapted to new .say idiom. Got rid of quotemeta implementation.

  • Property svn:mime-type set to text/plain; charset=UTF-8
  • Property svn:eol-style set to native
Line 
1#!/usr/bin/pugs
2# vim: filetype=perl6 :
3# Perl 6 variation of http://www.perlmonks.org/?node_id=567025.
4# You can change $command to reflect the actual command you want to use
5# (e.g. 'svk diff').
6
7use v6;
8
9# Default command, a hint on a possible different default is given as well
10# If $default_command is undef, then the command line will be called as-is
11my $default_command = 'diff';
12# $default_command = 'svk diff';
13
14# Color associations: red are "from", green are "to", blue are other stuff
15my %color_for = (
16    '<' => RED,
17    '-' => RED,
18    '>' => GREEN,
19    '+' => GREEN,
20    '@' => BLUE,
21    '=' => BLUE,
22);
23
24# If there are arguments, call the default command, otherwise get stdin
25my $fh = $*IN;
26if (@*ARGS.elems) {
27    my @args = @*ARGS;
28    unshift @args, $default_command if defined $default_command;
29    my $command = @args.map({ quotemeta($_) }).join(' ');
30    $fh = get_input_fh($command);
31}
32
33# Iterate over input and color it
34for =$fh {
35    my $first_char = substr $_, 0, 1;
36    delete %color_for{'-'} if $first_char eq '<';
37    print BOLD, %color_for{$first_char} if %color_for.exists($first_char);
38    .say;
39    print RESET if %color_for.exists($first_char);
40}
41close $fh;
42
43# Stripped down version of Term::ANSIColor
44sub _color ($color) { return "\x1b[" ~ $color ~ "m"; }
45sub RED   { return _color(31); }
46sub GREEN { return _color(32); }
47sub BLUE  { return _color(34); }
48sub BOLD  { return _color( 1); }
49sub RESET { return _color( 0); }
50
51######### WORKAROUNDS #####################################################
52
53# Wrapper function to substitute Perl 5 idiom:
54#
55#    open my $fh, '-|', $command;
56#
57# Will do better in the future, using Prelude
58sub get_input_fh ($command) {
59    my ($in, $out, $err, $pid) =
60        Pugs::Internals::runInteractiveCommand($command);
61    return $out;
62}
Note: See TracBrowser for help on using the browser.