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