tools/mkcaniuse

   1 #!/usr/bin/env perl
   2 use 5.010;
   3 use strict;
   4 use warnings;
   5
   6 use Data::Dump 'pp';
   7 use JSON;
   8
   9 if (@ARGV) {
  10         require Time::Piece;
  11         require LWP::UserAgent;
  12         require File::stat;
  13
  14         my $target = 'browser-support.inc.pl';
  15         my $source = 'http://caniuse.com/data.json';
  16
  17         my $ua = LWP::UserAgent->new;
  18         $ua->agent('sheet.shiar.nl/browser');
  19         $ua->default_header('If-Modified-Since' => scalar gmtime $_->mtime)
  20                 for File::stat::stat($target);
  21
  22         my $res = $ua->get($source) or die "No data from $source\n";
  23         !$res->is_error or die $res->status_line;
  24         say $res->status_line;
  25
  26         exit 0 if $res->code == 304;  # unmodified
  27
  28         my $data = decode_json($res->decoded_content) or die "Parse error: $!";
  29         my $updated = eval {
  30                 s/ GMT$//,
  31                 return Time::Piece->strptime($_) for $res->header('Last-Modified')
  32         };
  33         $data->{-date} = $_->datetime for $updated || ();
  34
  35         my $suffix = $updated && $updated->ymd || time;
  36         open my $save, '>', (my $download = "browser-support-$suffix.inc.pl");
  37         print {$save} pp($data);
  38         close $save;
  39
  40         symlink $download, "$target.new" and rename "$target.new", $target
  41                 or die "New data at $download not linked: $!";
  42         exit 0;
  43 }
  44
  45 local $/;  # slurp
  46 my $source = readline;
  47
  48 for ($source) { # cleanup
  49         s/\A\(// and s/\);?\s*\Z//;  # empty callback
  50         next if /^\{/;  # valid json
  51
  52         # convert seperate variables to hash keys
  53         s/\A/{\n/;
  54         s/^caniuse\.(\w+) *= */"$1":/gm;
  55         s/;$/,/gm;
  56         s/,\s*\Z/\n}/;
  57         # fractions not supported by barekey
  58         s/(?<=[,{\n]) (\d*\.\d) (?=:['"])/"$1"/gx;
  59         # escapes not supported in singlequote
  60         s{: *\K'((?:[^\\']+|\\.)*)'}{
  61                 my $_ = $1;
  62                 s/"/\\"/g;
  63                 s/\\'/'/g;
  64                 qq("$_");
  65         }ge;
  66 }
  67
  68 my $data = from_json($source, {
  69         allow_singlequote => 1,
  70         allow_barekey => 1,
  71 });
  72
  73 print pp($data);
  74
  75 __END__
  76
  77 =head1 NAME
  78
  79 mkcaniuse - Turn Javascript data into an equivalent Perl structure
  80
  81 =head1 SYNOPSIS
  82
  83         curl http://caniuse.com/data.json |
  84         tools/mkcaniuse.pl > browser-support.inc.pl
  85
  86         tools/mkcaniuse.pl auto
  87