examples/colordiff.pl

   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
   7 use 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
  11 my $default_command = 'diff';
  12 # $default_command = 'svk diff';
  13
  14 # Color associations: red are "from", green are "to", blue are other stuff
  15 my %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
  25 my $fh = $*IN;
  26 if (@*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
  34 for $fh.lines {
  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 }
  41 close $fh;
  42
  43 # Stripped down version of Term::ANSIColor
  44 sub _color ($color) { return "\x1b[" ~ $color ~ "m"; }
  45 sub RED   { return _color(31); }
  46 sub GREEN { return _color(32); }
  47 sub BLUE  { return _color(34); }
  48 sub BOLD  { return _color( 1); }
  49 sub 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
  58 sub get_input_fh ($command) {
  59     my ($in, $out, $err, $pid) =
  60         Pugs::Internals::runInteractiveCommand($command);
  61     return $out;
  62 }