← Back to branch summary

~ubuntu-branches/ubuntu/saucy/libmodule-install-doapchangesets-perl/saucy

« back to all changes in this revision

Viewing changes to inc/YAML/Tiny.pm

  • Committer: Package Import Robot
  • Author(s): Jonas Smedegaard, Jonas Smedegaard
  • Date: 2012-08-07 14:25:59 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120807142559-wukqwz5jfgytood9
Tags: 0.203-1
* New upstream release.

[ Jonas Smedegaard ]
* Bump debhelper compatibility level to 8.
* Update copyright file:
  + Fix use pseudo-license-in-comment and -comment-in-license fields:
    File format 1.0 mandates License field to either be single-line or
    include all licensing info.
  + Extend coverage of main project to include current year.
* Tidy rules file.
* Update package relations:
  + Recommend libmodule-install-doap-perl, libmodule-package-perl and
    recent libmodule-install-rdf-perl.
  + Relax to (build-)depend unversioned on cdbs: Needed version
    satisfied in stable, and oldstable no longer supported.
* Use metacpan.org page as Homepage.
* Use bugtracker as preferred upstream contact.

Show diffs side-by-side

added added

removed removed

Lines of Context:
inc/YAML/Tiny.pm
2
2
package YAML::Tiny;
3
3
 
4
4
use strict;
5
 
use Carp 'croak';
6
5
 
7
6
# UTF Support?
8
7
sub HAVE_UTF8 () { $] >= 5.007003 }
16
15
        # Class structure
17
16
        require 5.004;
18
17
        require Exporter;
19
 
        $YAML::Tiny::VERSION   = '1.41';
 
18
        require Carp;
 
19
        $YAML::Tiny::VERSION   = '1.51';
 
20
        # $YAML::Tiny::VERSION   = eval $YAML::Tiny::VERSION;
20
21
        @YAML::Tiny::ISA       = qw{ Exporter  };
21
22
        @YAML::Tiny::EXPORT    = qw{ Load Dump };
22
23
        @YAML::Tiny::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
27
28
 
28
29
# The character class of all characters we need to escape
29
30
# NOTE: Inlined, since it's only used once
30
 
# my $RE_ESCAPE   = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]';
 
31
# my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]';
31
32
 
32
33
# Printed form of the unprintable characters in the lowest range
33
34
# of ASCII characters, listed by ASCII ordinal position.
95
96
        my $class  = ref $_[0] ? ref shift : shift;
96
97
        my $self   = bless [], $class;
97
98
        my $string = $_[0];
98
 
        unless ( defined $string ) {
99
 
                return $self->_error("Did not provide a string to load");
100
 
        }
101
 
 
102
 
        # Byte order marks
103
 
        # NOTE: Keeping this here to educate maintainers
104
 
        # my %BOM = (
105
 
        #     "\357\273\277" => 'UTF-8',
106
 
        #     "\376\377"     => 'UTF-16BE',
107
 
        #     "\377\376"     => 'UTF-16LE',
108
 
        #     "\377\376\0\0" => 'UTF-32LE'
109
 
        #     "\0\0\376\377" => 'UTF-32BE',
110
 
        # );
111
 
        if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
112
 
                return $self->_error("Stream has a non UTF-8 BOM");
113
 
        } else {
114
 
                # Strip UTF-8 bom if found, we'll just ignore it
115
 
                $string =~ s/^\357\273\277//;
116
 
        }
117
 
 
118
 
        # Try to decode as utf8
119
 
        utf8::decode($string) if HAVE_UTF8;
120
 
 
121
 
        # Check for some special cases
122
 
        return $self unless length $string;
123
 
        unless ( $string =~ /[\012\015]+\z/ ) {
124
 
                return $self->_error("Stream does not end with newline character");
125
 
        }
126
 
 
127
 
        # Split the file into lines
128
 
        my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
129
 
                    split /(?:\015{1,2}\012|\015|\012)/, $string;
130
 
 
131
 
        # Strip the initial YAML header
132
 
        @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
133
 
 
134
 
        # A nibbling parser
135
 
        while ( @lines ) {
136
 
                # Do we have a document header?
137
 
                if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
138
 
                        # Handle scalar documents
139
 
                        shift @lines;
140
 
                        if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
141
 
                                push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
142
 
                                next;
143
 
                        }
144
 
                }
145
 
 
146
 
                if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
147
 
                        # A naked document
148
 
                        push @$self, undef;
149
 
                        while ( @lines and $lines[0] !~ /^---/ ) {
 
99
        eval {
 
100
                unless ( defined $string ) {
 
101
                        die \"Did not provide a string to load";
 
102
                }
 
103
 
 
104
                # Byte order marks
 
105
                # NOTE: Keeping this here to educate maintainers
 
106
                # my %BOM = (
 
107
                #     "\357\273\277" => 'UTF-8',
 
108
                #     "\376\377"     => 'UTF-16BE',
 
109
                #     "\377\376"     => 'UTF-16LE',
 
110
                #     "\377\376\0\0" => 'UTF-32LE'
 
111
                #     "\0\0\376\377" => 'UTF-32BE',
 
112
                # );
 
113
                if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
 
114
                        die \"Stream has a non UTF-8 BOM";
 
115
                } else {
 
116
                        # Strip UTF-8 bom if found, we'll just ignore it
 
117
                        $string =~ s/^\357\273\277//;
 
118
                }
 
119
 
 
120
                # Try to decode as utf8
 
121
                utf8::decode($string) if HAVE_UTF8;
 
122
 
 
123
                # Check for some special cases
 
124
                return $self unless length $string;
 
125
                unless ( $string =~ /[\012\015]+\z/ ) {
 
126
                        die \"Stream does not end with newline character";
 
127
                }
 
128
 
 
129
                # Split the file into lines
 
130
                my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
 
131
                            split /(?:\015{1,2}\012|\015|\012)/, $string;
 
132
 
 
133
                # Strip the initial YAML header
 
134
                @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
 
135
 
 
136
                # A nibbling parser
 
137
                while ( @lines ) {
 
138
                        # Do we have a document header?
 
139
                        if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
 
140
                                # Handle scalar documents
150
141
                                shift @lines;
151
 
                        }
152
 
 
153
 
                } elsif ( $lines[0] =~ /^\s*\-/ ) {
154
 
                        # An array at the root
155
 
                        my $document = [ ];
156
 
                        push @$self, $document;
157
 
                        $self->_read_array( $document, [ 0 ], \@lines );
158
 
 
159
 
                } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
160
 
                        # A hash at the root
161
 
                        my $document = { };
162
 
                        push @$self, $document;
163
 
                        $self->_read_hash( $document, [ length($1) ], \@lines );
164
 
 
165
 
                } else {
166
 
                        croak("YAML::Tiny failed to classify the line '$lines[0]'");
 
142
                                if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
 
143
                                        push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
 
144
                                        next;
 
145
                                }
 
146
                        }
 
147
 
 
148
                        if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
 
149
                                # A naked document
 
150
                                push @$self, undef;
 
151
                                while ( @lines and $lines[0] !~ /^---/ ) {
 
152
                                        shift @lines;
 
153
                                }
 
154
 
 
155
                        } elsif ( $lines[0] =~ /^\s*\-/ ) {
 
156
                                # An array at the root
 
157
                                my $document = [ ];
 
158
                                push @$self, $document;
 
159
                                $self->_read_array( $document, [ 0 ], \@lines );
 
160
 
 
161
                        } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
 
162
                                # A hash at the root
 
163
                                my $document = { };
 
164
                                push @$self, $document;
 
165
                                $self->_read_hash( $document, [ length($1) ], \@lines );
 
166
 
 
167
                        } else {
 
168
                                die \"YAML::Tiny failed to classify the line '$lines[0]'";
 
169
                        }
167
170
                }
 
171
        };
 
172
        if ( ref $@ eq 'SCALAR' ) {
 
173
                return $self->_error(${$@});
 
174
        } elsif ( $@ ) {
 
175
                require Carp;
 
176
                Carp::croak($@);
168
177
        }
169
178
 
170
 
        $self;
 
179
        return $self;
171
180
}
172
181
 
173
182
# Deparse a scalar string to the actual scalar
181
190
        return undef if $string eq '~';
182
191
 
183
192
        # Single quote
184
 
        if ( $string =~ /^\'(.*?)\'\z/ ) {
 
193
        if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
185
194
                return '' unless defined $1;
186
195
                $string = $1;
187
196
                $string =~ s/\'\'/\'/g;
193
202
        # engine due to recursion and backtracking problems on strings
194
203
        # larger than 32,000ish characters. Keep it for reference purposes.
195
204
        # if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
196
 
        if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"\z/ ) {
 
205
        if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\z/ ) {
197
206
                # Reusing the variable is a little ugly,
198
207
                # but avoids a new variable and a string copy.
199
208
                $string = $1;
204
213
 
205
214
        # Special cases
206
215
        if ( $string =~ /^[\'\"!&]/ ) {
207
 
                croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
 
216
                die \"YAML::Tiny does not support a feature in line '$string'";
208
217
        }
209
 
        return {} if $string eq '{}';
210
 
        return [] if $string eq '[]';
 
218
        return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
 
219
        return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
211
220
 
212
221
        # Regular unquoted string
213
 
        return $string unless $string =~ /^[>|]/;
 
222
        if ( $string !~ /^[>|]/ ) {
 
223
                if (
 
224
                        $string =~ /^(?:-(?:\s|$)|[\@\%\`])/
 
225
                        or
 
226
                        $string =~ /:(?:\s|$)/
 
227
                ) {
 
228
                        die \"YAML::Tiny found illegal characters in plain scalar: '$string'";
 
229
                }
 
230
                $string =~ s/\s+#.*\z//;
 
231
                return $string;
 
232
        }
214
233
 
215
234
        # Error
216
 
        croak("YAML::Tiny failed to find multi-line scalar content") unless @$lines;
 
235
        die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines;
217
236
 
218
237
        # Check the indent depth
219
238
        $lines->[0]   =~ /^(\s*)/;
220
239
        $indent->[-1] = length("$1");
221
240
        if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
222
 
                croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
 
241
                die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
223
242
        }
224
243
 
225
244
        # Pull the lines
253
272
                if ( length($1) < $indent->[-1] ) {
254
273
                        return 1;
255
274
                } elsif ( length($1) > $indent->[-1] ) {
256
 
                        croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
 
275
                        die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
257
276
                }
258
277
 
259
278
                if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
290
309
                                $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
291
310
 
292
311
                        } else {
293
 
                                croak("YAML::Tiny failed to classify line '$lines->[0]'");
 
312
                                die \"YAML::Tiny failed to classify line '$lines->[0]'";
294
313
                        }
295
314
 
296
315
                } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
304
323
                        return 1;
305
324
 
306
325
                } else {
307
 
                        croak("YAML::Tiny failed to classify line '$lines->[0]'");
 
326
                        die \"YAML::Tiny failed to classify line '$lines->[0]'";
308
327
                }
309
328
        }
310
329
 
329
348
                if ( length($1) < $indent->[-1] ) {
330
349
                        return 1;
331
350
                } elsif ( length($1) > $indent->[-1] ) {
332
 
                        croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
 
351
                        die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
333
352
                }
334
353
 
335
354
                # Get the key
336
 
                unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
 
355
                unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
337
356
                        if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
338
 
                                croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
 
357
                                die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
339
358
                        }
340
 
                        croak("YAML::Tiny failed to classify line '$lines->[0]'");
 
359
                        die \"YAML::Tiny failed to classify line '$lines->[0]'";
341
360
                }
342
361
                my $key = $1;
343
362
 
422
441
                        push @lines, $self->_write_hash( $cursor, $indent, {} );
423
442
 
424
443
                } else {
425
 
                        croak("Cannot serialize " . ref($cursor));
 
444
                        Carp::croak("Cannot serialize " . ref($cursor));
426
445
                }
427
446
        }
428
447
 
440
459
                $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
441
460
                return qq|"$string"|;
442
461
        }
443
 
        if ( $string =~ /(?:^\W|\s)/ or $QUOTE{$string} ) {
 
462
        if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) {
444
463
                return "'$string'";
445
464
        }
446
465
        return $string;
550
569
sub Load {
551
570
        my $self = YAML::Tiny->read_string(@_);
552
571
        unless ( $self ) {
553
 
                croak("Failed to load YAML document from string");
 
572
                Carp::croak("Failed to load YAML document from string");
554
573
        }
555
574
        if ( wantarray ) {
556
575
                return @$self;
573
592
sub LoadFile {
574
593
        my $self = YAML::Tiny->read($_[0]);
575
594
        unless ( $self ) {
576
 
                croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
 
595
                Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
577
596
        }
578
597
        if ( wantarray ) {
579
598
                return @$self;
591
610
# Use Scalar::Util if possible, otherwise emulate it
592
611
 
593
612
BEGIN {
 
613
        local $@;
594
614
        eval {
595
615
                require Scalar::Util;
596
616
        };
597
 
        if ( $@ ) {
598
 
                # Failed to load Scalar::Util
 
617
        my $v = eval("$Scalar::Util::VERSION") || 0;
 
618
        if ( $@ or $v < 1.18 ) {
599
619
                eval <<'END_PERL';
 
620
# Scalar::Util failed to load or too old
600
621
sub refaddr {
601
622
        my $pkg = ref($_[0]) or return undef;
602
 
        if (!!UNIVERSAL::can($_[0], 'can')) {
 
623
        if ( !! UNIVERSAL::can($_[0], 'can') ) {
603
624
                bless $_[0], 'Scalar::Util::Fake';
604
625
        } else {
605
626
                $pkg = undef;
611
632
}
612
633
END_PERL
613
634
        } else {
614
 
                Scalar::Util->import('refaddr');
 
635
                *refaddr = *Scalar::Util::refaddr;
615
636
        }
616
637
}
617
638
 
619
640
 
620
641
__END__
621
642
 
622
 
#line 1132
 
643
#line 1175