tabdata/td-format

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 td-format - Print formatted lines per Tabular Data record
   8
   9 =head1 SYNOPSIS
  10
  11 td-format I<TEMPLATE>
  12
  13 =head1 DESCRIPTION
  14
  15 =head1 OPTIONS
  16
  17 =over 4
  18
  19 =item --nofield=[B<empty>|B<leave>|B<name>|B<skip-record>|B<fail>]
  20
  21 How to resolve non-existent field names in template variables?
  22
  23 =over 8
  24
  25 =item B<empty>
  26
  27 Replace with empty string.
  28 This is the default.
  29
  30 =item B<leave>
  31
  32 Leave the C<{field_name>}> string there unresolved.
  33
  34 =item B<name>
  35
  36 Replace with the field name itself.
  37
  38 =item B<skip-record>
  39
  40 Don't output anything for the given record.
  41 Continue with the next one.
  42
  43 =item B<fail>
  44
  45 Exit the program immediately with error code.
  46
  47 =back
  48
  49 =item -n
  50
  51 No newline.
  52
  53 =back
  54
  55 =head1 SEE ALSO
  56
  57 =cut
  58
  59
  60 use Switch;
  61 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  62
  63
  64 sub replace_nofield
  65 {
  66         my $fieldname = shift;
  67         my $template_fragment = shift;
  68         my $callback_data = shift;
  69
  70         switch($OptNoFieldBehavior)
  71         {
  72                 case('empty') { return ''; }
  73                 case('leave') { return $template_fragment; }
  74                 case('name') { return $fieldname; }
  75                 case('skip-record') { $callback_data->{'skip-record'} = 1; die; }
  76                 case('fail') { $callback_data->{'fail'} = 1; $callback_data->{'missing-field-name'} = $fieldname; die; }
  77         }
  78 }
  79
  80 sub render
  81 {
  82         my $s = shift;
  83         my $fields = shift;
  84         my $callback_data = shift;
  85         $s =~ s{\{([^{}]*)\}}{$fields->{$1} // replace_nofield($1, $&, $callback_data)}eg;
  86         return $s;
  87 }
  88
  89
  90 @NoFieldBehaviorValues = (qw/empty leave name skip-record fail/);
  91 $OptNoFieldBehavior = 'empty';
  92 $OptNoNewline = 0;
  93
  94 %OptionDefs = (
  95         'nofield=s' => \$OptNoFieldBehavior,
  96         'n' => \$OptNoNewline,
  97 );
  98
  99 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
 100
 101 pod2usage(-exitval=>2, -verbose=>99) if not $OptNoFieldBehavior ~~ @NoFieldBehaviorValues;
 102
 103 @Templates = @ARGV;
 104
 105
 106
 107 process_header(scalar <STDIN>);
 108
 109 RECORD:
 110 while(not eof STDIN)
 111 {
 112         my @row = read_record(\*STDIN);
 113         my %fields = map {( $_ => $row[$Header{$_}] )} keys %Header;
 114         my $callback_data = {};
 115         my $output;
 116         eval {
 117                 $output = join $FS, map {render($_, \%fields, $callback_data)} @Templates; 1;
 118         }
 119         or do {
 120                 if($callback_data->{'skip-record'}) { next RECORD; }
 121                 if($callback_data->{'fail'}) { die sprintf "%s: no such field: %s\n", $0, $callback_data->{'missing-field-name'}; }
 122         };
 123         $output .= $RS unless $OptNoNewline;
 124         print $output;
 125 }