summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 12:20:49 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 12:20:49 +0000
commit316ee97c621496b0fe3267f57cce81bee44ca1e6 (patch)
treecb2cab1192b4f58a7971af19b213e980bceda4b4 /Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
parentcd0f87b5d39480d85ad9bd4ee37f520f75bed560 (diff)
Moving old tlperl prior to committing new one
git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm333
1 files changed, 0 insertions, 333 deletions
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
deleted file mode 100755
index 04ea4d10bd6..00000000000
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
+++ /dev/null
@@ -1,333 +0,0 @@
-package TAP::Parser::YAMLish::Reader;
-
-use strict;
-use vars qw($VERSION @ISA);
-
-use TAP::Object ();
-
-@ISA = 'TAP::Object';
-$VERSION = '3.20';
-
-# TODO:
-# Handle blessed object syntax
-
-# Printable characters for escapes
-my %UNESCAPES = (
- z => "\x00", a => "\x07", t => "\x09",
- n => "\x0a", v => "\x0b", f => "\x0c",
- r => "\x0d", e => "\x1b", '\\' => '\\',
-);
-
-my $QQ_STRING = qr{ " (?:\\. | [^"])* " }x;
-my $HASH_LINE = qr{ ^ ($QQ_STRING|\S+) \s* : \s* (?: (.+?) \s* )? $ }x;
-my $IS_HASH_KEY = qr{ ^ [\w\'\"] }x;
-my $IS_END_YAML = qr{ ^ \.\.\. \s* $ }x;
-my $IS_QQ_STRING = qr{ ^ $QQ_STRING $ }x;
-
-# new() implementation supplied by TAP::Object
-
-sub read {
- my $self = shift;
- my $obj = shift;
-
- die "Must have a code reference to read input from"
- unless ref $obj eq 'CODE';
-
- $self->{reader} = $obj;
- $self->{capture} = [];
-
- # Prime the reader
- $self->_next;
- return unless $self->{next};
-
- my $doc = $self->_read;
-
- # The terminator is mandatory otherwise we'd consume a line from the
- # iterator that doesn't belong to us. If we want to remove this
- # restriction we'll have to implement look-ahead in the iterators.
- # Which might not be a bad idea.
- my $dots = $self->_peek;
- die "Missing '...' at end of YAMLish"
- unless defined $dots
- and $dots =~ $IS_END_YAML;
-
- delete $self->{reader};
- delete $self->{next};
-
- return $doc;
-}
-
-sub get_raw { join( "\n", grep defined, @{ shift->{capture} || [] } ) . "\n" }
-
-sub _peek {
- my $self = shift;
- return $self->{next} unless wantarray;
- my $line = $self->{next};
- $line =~ /^ (\s*) (.*) $ /x;
- return ( $2, length $1 );
-}
-
-sub _next {
- my $self = shift;
- die "_next called with no reader"
- unless $self->{reader};
- my $line = $self->{reader}->();
- $self->{next} = $line;
- push @{ $self->{capture} }, $line;
-}
-
-sub _read {
- my $self = shift;
-
- my $line = $self->_peek;
-
- # Do we have a document header?
- if ( $line =~ /^ --- (?: \s* (.+?) \s* )? $/x ) {
- $self->_next;
-
- return $self->_read_scalar($1) if defined $1; # Inline?
-
- my ( $next, $indent ) = $self->_peek;
-
- if ( $next =~ /^ - /x ) {
- return $self->_read_array($indent);
- }
- elsif ( $next =~ $IS_HASH_KEY ) {
- return $self->_read_hash( $next, $indent );
- }
- elsif ( $next =~ $IS_END_YAML ) {
- die "Premature end of YAMLish";
- }
- else {
- die "Unsupported YAMLish syntax: '$next'";
- }
- }
- else {
- die "YAMLish document header not found";
- }
-}
-
-# Parse a double quoted string
-sub _read_qq {
- my $self = shift;
- my $str = shift;
-
- unless ( $str =~ s/^ " (.*?) " $/$1/x ) {
- die "Internal: not a quoted string";
- }
-
- $str =~ s/\\"/"/gx;
- $str =~ s/ \\ ( [tartan\\favez] | x([0-9a-fA-F]{2}) )
- / (length($1) > 1) ? pack("H2", $2) : $UNESCAPES{$1} /gex;
- return $str;
-}
-
-# Parse a scalar string to the actual scalar
-sub _read_scalar {
- my $self = shift;
- my $string = shift;
-
- return undef if $string eq '~';
- return {} if $string eq '{}';
- return [] if $string eq '[]';
-
- if ( $string eq '>' || $string eq '|' ) {
-
- my ( $line, $indent ) = $self->_peek;
- die "Multi-line scalar content missing" unless defined $line;
-
- my @multiline = ($line);
-
- while (1) {
- $self->_next;
- my ( $next, $ind ) = $self->_peek;
- last if $ind < $indent;
-
- my $pad = $string eq '|' ? ( ' ' x ( $ind - $indent ) ) : '';
- push @multiline, $pad . $next;
- }
-
- return join( ( $string eq '>' ? ' ' : "\n" ), @multiline ) . "\n";
- }
-
- if ( $string =~ /^ ' (.*) ' $/x ) {
- ( my $rv = $1 ) =~ s/''/'/g;
- return $rv;
- }
-
- if ( $string =~ $IS_QQ_STRING ) {
- return $self->_read_qq($string);
- }
-
- if ( $string =~ /^['"]/ ) {
-
- # A quote with folding... we don't support that
- die __PACKAGE__ . " does not support multi-line quoted scalars";
- }
-
- # Regular unquoted string
- return $string;
-}
-
-sub _read_nested {
- my $self = shift;
-
- my ( $line, $indent ) = $self->_peek;
-
- if ( $line =~ /^ -/x ) {
- return $self->_read_array($indent);
- }
- elsif ( $line =~ $IS_HASH_KEY ) {
- return $self->_read_hash( $line, $indent );
- }
- else {
- die "Unsupported YAMLish syntax: '$line'";
- }
-}
-
-# Parse an array
-sub _read_array {
- my ( $self, $limit ) = @_;
-
- my $ar = [];
-
- while (1) {
- my ( $line, $indent ) = $self->_peek;
- last
- if $indent < $limit
- || !defined $line
- || $line =~ $IS_END_YAML;
-
- if ( $indent > $limit ) {
- die "Array line over-indented";
- }
-
- if ( $line =~ /^ (- \s+) \S+ \s* : (?: \s+ | $ ) /x ) {
- $indent += length $1;
- $line =~ s/-\s+//;
- push @$ar, $self->_read_hash( $line, $indent );
- }
- elsif ( $line =~ /^ - \s* (.+?) \s* $/x ) {
- die "Unexpected start of YAMLish" if $line =~ /^---/;
- $self->_next;
- push @$ar, $self->_read_scalar($1);
- }
- elsif ( $line =~ /^ - \s* $/x ) {
- $self->_next;
- push @$ar, $self->_read_nested;
- }
- elsif ( $line =~ $IS_HASH_KEY ) {
- $self->_next;
- push @$ar, $self->_read_hash( $line, $indent, );
- }
- else {
- die "Unsupported YAMLish syntax: '$line'";
- }
- }
-
- return $ar;
-}
-
-sub _read_hash {
- my ( $self, $line, $limit ) = @_;
-
- my $indent;
- my $hash = {};
-
- while (1) {
- die "Badly formed hash line: '$line'"
- unless $line =~ $HASH_LINE;
-
- my ( $key, $value ) = ( $self->_read_scalar($1), $2 );
- $self->_next;
-
- if ( defined $value ) {
- $hash->{$key} = $self->_read_scalar($value);
- }
- else {
- $hash->{$key} = $self->_read_nested;
- }
-
- ( $line, $indent ) = $self->_peek;
- last
- if $indent < $limit
- || !defined $line
- || $line =~ $IS_END_YAML;
- }
-
- return $hash;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-TAP::Parser::YAMLish::Reader - Read YAMLish data from iterator
-
-=head1 VERSION
-
-Version 3.20
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-Note that parts of this code were derived from L<YAML::Tiny> with the
-permission of Adam Kennedy.
-
-=head1 METHODS
-
-=head2 Class Methods
-
-=head3 C<new>
-
-The constructor C<new> creates and returns an empty
-C<TAP::Parser::YAMLish::Reader> object.
-
- my $reader = TAP::Parser::YAMLish::Reader->new;
-
-=head2 Instance Methods
-
-=head3 C<read>
-
- my $got = $reader->read($iterator);
-
-Read YAMLish from a L<TAP::Parser::Iterator> and return the data structure it
-represents.
-
-=head3 C<get_raw>
-
- my $source = $reader->get_source;
-
-Return the raw YAMLish source from the most recent C<read>.
-
-=head1 AUTHOR
-
-Andy Armstrong, <andy@hexten.net>
-
-Adam Kennedy wrote L<YAML::Tiny> which provided the template and many of
-the YAML matching regular expressions for this module.
-
-=head1 SEE ALSO
-
-L<YAML::Tiny>, L<YAML>, L<YAML::Syck>, L<Config::Tiny>, L<CSS::Tiny>,
-L<http://use.perl.org/~Alias/journal/29427>
-
-=head1 COPYRIGHT
-
-Copyright 2007-2008 Andy Armstrong.
-
-Portions copyright 2006-2008 Adam Kennedy.
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=cut
-