lib/aur-format

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4
   5 use open ":std", ":encoding(UTF-8)";
   6 use POSIX qw(strftime);
   7 use v5.20;
   8
   9 use AUR::Json qw(parse_json parse_json_aur);
  10 my $argv0 = 'format';
  11
  12 # Dictionary for formatter string - subset of package-query(1) format options
  13 # Save type of attribute (AUR, pacman or both) for --dump-format
  14 my %aur_formats = (
  15     'a' => ['array',    'Arch'          ],
  16     'c' => ['array',    'CheckDepends'  ],
  17     'C' => ['array',    'Conflicts'     ],
  18     'D' => ['array',    'Depends'       ],
  19     'e' => ['array',    'License'       ],
  20     'F' => ['array',    'Files'         ],  # aur-repo-parse
  21     'g' => ['array',    'Groups'        ],
  22     'K' => ['array',    'Keywords'      ],
  23     'M' => ['array',    'MakeDepends'   ],
  24     'O' => ['array',    'OptDepends'    ],
  25     'P' => ['array',    'Provides'      ],
  26     'b' => ['string',   'PackageBase'   ],
  27     'd' => ['string',   'Description'   ],
  28     'f' => ['string',   'FileName'      ],  # aur-repo-parse
  29     'm' => ['string',   'Maintainer'    ],
  30     'n' => ['string',   'Name'          ],
  31     'r' => ['string',   'DBPath'        ],  # aur-repo-parse
  32     'U' => ['string',   'URL'           ],
  33     'v' => ['string',   'Version'       ],
  34     's' => ['string',   'Submitter'     ],  # aur-pkglist
  35     'L' => ['epoch',    'LastModified'  ],
  36     'o' => ['epoch',    'OutOfDate'     ],
  37     'S' => ['epoch',    'FirstSubmitted'],
  38     'p' => ['numeric',  'Popularity'    ],
  39     'w' => ['numeric',  'NumVotes'      ]
  40 );
  41
  42 # Known AUR types for use with --format, --gron
  43 my %aur_types = map { ($_->[1] => $_->[0]) } values %aur_formats;
  44
  45 sub tokenize {
  46     my ($format, $delim) = @_;
  47
  48     if (!length($format)) {
  49         say STDERR "$argv0: empty format specified";
  50         exit(1);
  51     }
  52     # omit trailing empty fields
  53     my @tokens = split('%', $format);
  54
  55     # ignore first field: split("%a%b") -> ("", 'a', 'b')
  56     my @labels = ("");
  57     my @suffix = ($tokens[0]);
  58
  59     for my $i (1..$#tokens) {
  60         my $token = $tokens[$i];
  61
  62         if (length($token)) {
  63             # Expand first character, preserve the rest
  64             my $token_1 = substr($token, 0, 1);
  65             my $label = $aur_formats{$token_1}->[1] // "";
  66             my $rest;
  67
  68             if (not length($label) and (length($tokens[$i-1]) > 0 or $i == 1)) {
  69                 die $argv0 . ': invalid format key specified';
  70             } elsif (not length($label)) {
  71                 $rest = $token; # Special case for %%
  72             } else {
  73                 $rest = substr($token, 1);
  74             }
  75             # Unescape shell-quoted strings, e.g. --format '%n\t%v\n'
  76             $rest =~ s/(?<!\\)\\t/\t/g; # do not unescape '\\t'
  77             $rest =~ s/(?<!\\)\\n/\n/g;
  78             $rest =~ s/(?<!\\)\\0/\0/g;
  79
  80             push(@labels, $label);
  81             push(@suffix, $rest);
  82         } else {
  83             push(@labels, "");
  84             push(@suffix, "%");
  85         }
  86     }
  87     return \@labels, \@suffix;
  88 }
  89
  90 sub info_expand_field {
  91     my ($value, $label, $delim, $time_fmt) = @_;
  92
  93     if (not defined($value)) {
  94         return "";
  95     } elsif (ref($value) eq 'ARRAY') {
  96         return join($delim, @{$value});
  97     } elsif ($aur_types{$label} eq 'epoch') {
  98         return strftime($time_fmt, gmtime $value);
  99     } else {
 100         return $value;
 101     }
 102 }
 103
 104 # Expand tokens to AUR data
 105 sub info_format {
 106     my ($pkg, $labels, $rest, $delim, $verbose, $time_fmt) = @_;
 107
 108     if (ref($pkg) ne 'HASH') {
 109         say STDERR "$argv0: --format requires dictionary input";
 110         exit(4);
 111     }
 112
 113     my @fmt;
 114     for my $i (0..$#{$labels}) {
 115         my ($label, $suffix) = ($labels->[$i], $rest->[$i]);
 116
 117         if (length($label)) {
 118             my $field = info_expand_field($pkg->{$label}, $label, $delim, $time_fmt);
 119
 120             if (not length($field) and $verbose) {
 121                 $field = "-";
 122             }
 123             push(@fmt, $field . $suffix);
 124         } else {
 125             push(@fmt, $suffix);
 126         }
 127     }
 128     my $fmt_string = join('', @fmt);
 129     print($fmt_string);
 130 }
 131
 132 sub info_gron {
 133     my ($pkg, $prefix, $key) = @_;
 134
 135     if (not defined($pkg)) {
 136         say join(' = ', $prefix, 'null;');
 137     }
 138     elsif (not length(ref($pkg))) {
 139         # Use known types instead of best-effort basis (`looks_like_number`)
 140         my $aur_type = $aur_types{$key // ""};
 141
 142         if (not (defined $aur_type and ($aur_type eq 'numeric' or $aur_type eq 'epoch'))) {
 143             $pkg =~ s/\\/\\\\/g;         # escape backslashes
 144             $pkg =~ s/(?<!\\)\"/\\"/g;   # escape double quotes
 145             $pkg =~ s/\x1B/\\u001B/g;    # escape ANSI sequences
 146             $pkg = "\"$pkg\"";           # enquote
 147         }
 148         say join(' = ', $prefix, $pkg . ';');
 149     }
 150     elsif (ref($pkg) eq 'HASH') {
 151         say "$prefix = {};";
 152
 153         for my $key (sort keys %{$pkg}) {
 154             my $value = $pkg->{$key};
 155
 156             info_gron($value, join(".", $prefix, $key), $key);
 157         }
 158     }
 159     elsif (ref($pkg) eq 'ARRAY') {
 160         say "$prefix = [];";
 161
 162         my $index = 0;
 163         map { info_gron($_, $prefix . "[" . $index++ . "]", undef) } @{$pkg};
 164     }
 165 }
 166
 167 # https://www.drdobbs.com/scripts-as-modules/184416165
 168 unless (caller) {
 169     # option handling
 170     use Getopt::Long;
 171     my $opt_mode;
 172     my $opt_delim;        # delimiter for arrays
 173     my $opt_verbose = 0;  # inserts "-" for empty fields with --format
 174     my $opt_format;
 175     my $opt_time_fmt;
 176
 177     GetOptions(
 178         'f|format=s'    => sub { $opt_mode = 'format',
 179                                  $opt_format = $_[1] },
 180         'gron'          => sub { $opt_mode = 'gron' },
 181         'd|delim=s'     => \$opt_delim,
 182         'v|verbose'     => \$opt_verbose,
 183         'time-format=s' => \$opt_time_fmt
 184     ) or exit(1);
 185
 186     if (not length($opt_time_fmt)) {
 187         $opt_time_fmt = "%a %b %e %H:%M:%S %Y";
 188     }
 189     if (not length($opt_delim)) {
 190         $opt_delim = " ";
 191     }
 192     if (not length($opt_mode)) {
 193         say STDERR "$argv0: no mode specified";
 194         exit(1);
 195     }
 196
 197     # main loops
 198     if ($opt_mode eq 'gron') {
 199         while (my $row = <ARGV>) {
 200             my $obj = parse_json($row);
 201
 202             info_gron($obj, "json");
 203         }
 204         die if $!;
 205     }
 206     elsif ($opt_mode eq 'format') {
 207         while (my $row = <ARGV>) {
 208             my @results = parse_json_aur($row);
 209
 210             my ($fmt, $suffix) = tokenize($opt_format);
 211             die unless (scalar @{$fmt} eq scalar @{$suffix});
 212
 213             map { info_format($_, $fmt, $suffix, $opt_delim, $opt_verbose, $opt_time_fmt) } @results;
 214         }
 215         die if $!;
 216     }
 217     else {
 218         say STDERR "$argv0: unknown mode $opt_mode";
 219         exit(1);
 220     }
 221 }
 222
 223 # vim: set et sw=4 sts=4 ft=perl: