Advertisement
Guest User

Untitled

a guest
Jul 8th, 2019
82
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 2.88 KB | None | 0 0
  1. ################################################################
  2. #
  3. # Copyright (c) 2018 SUSE Linux Products GmbH
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License version 2 or 3 as
  7. # published by the Free Software Foundation.
  8. #
  9. # This program is distributed in the hope that it will be useful,
  10. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. # GNU General Public License for more details.
  13. #
  14. # You should have received a copy of the GNU General Public License
  15. # along with this program (see the file COPYING); if not, write to the
  16. # Free Software Foundation, Inc.,
  17. # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
  18. #
  19. ################################################################
  20.  
  21. package Build::SimpleJSON;
  22.  
  23. use strict;
  24.  
  25. sub unparse_keys {
  26.   my ($d) = @_;
  27.   my @k = grep {$_ ne '_start' && $_ ne '_end' && $_ ne '_order' && $_ ne '_type'} sort keys %$d;
  28.   return @k unless $d->{'_order'};
  29.   my %k = map {$_ => 1} @k;
  30.   my @ko;
  31.   for (@{$d->{'_order'}}) {
  32.     push @ko, $_ if delete $k{$_};
  33.   }
  34.   return (@ko, grep {$k{$_}} @k);
  35. }
  36.  
  37. my %specialescapes = (
  38.   '"' => '\\"',
  39.   '\\' => '\\\\',
  40.   '/' => '\\/',
  41.   "\b" => '\\b',
  42.   "\f" => '\\f',
  43.   "\n" => '\\n',
  44.   "\r" => '\\r',
  45.   "\t" => '\\t',
  46. );
  47.  
  48. sub unparse_string {
  49.   my ($d) = @_;
  50.   $d =~ s/([\"\\\000-\037])/$specialescapes{$1} || sprintf('\\u%04d', ord($1))/ge;
  51.   return "\"$d\"";
  52. }
  53.  
  54. sub unparse_bool {
  55.   my ($d) = @_;
  56.   return $d ? 'true' : 'false';
  57. }
  58.  
  59. sub unparse_number {
  60.   my ($d) = @_;
  61.   return sprintf("%.f", $d) if $d == int($d);
  62.   return sprintf("%g", $d);
  63. }
  64.  
  65. sub unparse {
  66.   my ($d, %opts) = @_;
  67.  
  68.   my $r = '';
  69.   if (ref($d) eq 'ARRAY') {
  70.     return '[]' unless @$d;
  71.     my $indent = $opts{'ugly'} ? '' : $opts{'indent'} || '';
  72.     my $nl = $opts{'ugly'} ? '' : "\n";
  73.     my $sp = $opts{'ugly'} ? '' : " ";
  74.     my $first = 0;
  75.     for my $dd (@$d) {
  76.       $r .= ",$nl" if $first++;
  77.       $r .= "$indent$sp$sp$sp".unparse($dd, %opts, 'indent' => "   $indent");
  78.     }
  79.     return "\[$nl$r$nl$indent\]";
  80.   }
  81.   if (ref($d) eq 'HASH') {
  82.     my @k = unparse_keys($d);
  83.     return '{}' unless @k;
  84.     my $indent = $opts{'ugly'} ? '' : $opts{'indent'} || '';
  85.     my $nl = $opts{'ugly'} ? '' : "\n";
  86.     my $sp = $opts{'ugly'} ? '' : " ";
  87.     my $first = 0;
  88.     for my $k (@k) {
  89.       $r .= ",$nl" if $first++;
  90.       my $dd = $d->{$k};
  91.       $r .= "$indent$sp$sp$sp".unparse_string($k)."$sp:$sp".unparse($dd, %opts, 'indent' => "   $indent", '_type' => ($d->{'_type'} || {})->{$k});
  92.     }
  93.     return "\{$nl$r$nl$indent\}";
  94.   }
  95.   return 'null' unless defined $d;
  96.   my $type = $opts{'_type'} || '';
  97.   return unparse_bool($d) if $type eq 'bool';
  98.   return unparse_number($d) if $type eq 'number';
  99.   return unparse_string($d);
  100. }
  101.  
  102. 1;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement