X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-Catalyst-Plugin-Sitemap;a=blobdiff_plain;f=t%2F000-report-versions.t;fp=t%2F000-report-versions.t;h=2d4a9a19c729b9c712ac982b7621ffc22093f58a;hp=0000000000000000000000000000000000000000;hb=d074ab5a56e8e690399d2a01691724fcaf4bc41f;hpb=37c98d0f5cf106f60d1c2eda21938562c0494518

diff --git a/t/000-report-versions.t b/t/000-report-versions.t
new file mode 100644
index 0000000..2d4a9a1
--- /dev/null
+++ b/t/000-report-versions.t
@@ -0,0 +1,446 @@
+#!perl
+use warnings;
+use strict;
+use Test::More 0.94;
+
+# Include a cut-down version of YAML::Tiny so we don't introduce unnecessary
+# dependencies ourselves.
+
+package Local::YAML::Tiny;
+
+use strict;
+use Carp 'croak';
+
+# UTF Support?
+sub HAVE_UTF8 () { $] >= 5.007003 }
+BEGIN {
+    if ( HAVE_UTF8 ) {
+        # The string eval helps hide this from Test::MinimumVersion
+        eval "require utf8;";
+        die "Failed to load UTF-8 support" if $@;
+    }
+
+    # Class structure
+    require 5.004;
+    $YAML::Tiny::VERSION   = '1.40';
+
+    # Error storage
+    $YAML::Tiny::errstr    = '';
+}
+
+# Printable characters for escapes
+my %UNESCAPES = (
+    z => "\x00", a => "\x07", t    => "\x09",
+    n => "\x0a", v => "\x0b", f    => "\x0c",
+    r => "\x0d", e => "\x1b", '\\' => '\\',
+);
+
+
+#####################################################################
+# Implementation
+
+# Create an empty YAML::Tiny object
+sub new {
+    my $class = shift;
+    bless [ @_ ], $class;
+}
+
+# Create an object from a file
+sub read {
+    my $class = ref $_[0] ? ref shift : shift;
+
+    # Check the file
+    my $file = shift or return $class->_error( 'You did not specify a file name' );
+    return $class->_error( "File '$file' does not exist" )              unless -e $file;
+    return $class->_error( "'$file' is a directory, not a file" )       unless -f _;
+    return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
+
+    # Slurp in the file
+    local $/ = undef;
+    local *CFG;
+    unless ( open(CFG, $file) ) {
+        return $class->_error("Failed to open file '$file': $!");
+    }
+    my $contents = <CFG>;
+    unless ( close(CFG) ) {
+        return $class->_error("Failed to close file '$file': $!");
+    }
+
+    $class->read_string( $contents );
+}
+
+# Create an object from a string
+sub read_string {
+    my $class  = ref $_[0] ? ref shift : shift;
+    my $self   = bless [], $class;
+    my $string = $_[0];
+    unless ( defined $string ) {
+        return $self->_error("Did not provide a string to load");
+    }
+
+    # Byte order marks
+    # NOTE: Keeping this here to educate maintainers
+    # my %BOM = (
+    #     "\357\273\277" => 'UTF-8',
+    #     "\376\377"     => 'UTF-16BE',
+    #     "\377\376"     => 'UTF-16LE',
+    #     "\377\376\0\0" => 'UTF-32LE'
+    #     "\0\0\376\377" => 'UTF-32BE',
+    # );
+    if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
+        return $self->_error("Stream has a non UTF-8 BOM");
+    } else {
+        # Strip UTF-8 bom if found, we'll just ignore it
+        $string =~ s/^\357\273\277//;
+    }
+
+    # Try to decode as utf8
+    utf8::decode($string) if HAVE_UTF8;
+
+    # Check for some special cases
+    return $self unless length $string;
+    unless ( $string =~ /[\012\015]+\z/ ) {
+        return $self->_error("Stream does not end with newline character");
+    }
+
+    # Split the file into lines
+    my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
+                split /(?:\015{1,2}\012|\015|\012)/, $string;
+
+    # Strip the initial YAML header
+    @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
+
+    # A nibbling parser
+    while ( @lines ) {
+        # Do we have a document header?
+        if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
+            # Handle scalar documents
+            shift @lines;
+            if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
+                push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
+                next;
+            }
+        }
+
+        if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
+            # A naked document
+            push @$self, undef;
+            while ( @lines and $lines[0] !~ /^---/ ) {
+                shift @lines;
+            }
+
+        } elsif ( $lines[0] =~ /^\s*\-/ ) {
+            # An array at the root
+            my $document = [ ];
+            push @$self, $document;
+            $self->_read_array( $document, [ 0 ], \@lines );
+
+        } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
+            # A hash at the root
+            my $document = { };
+            push @$self, $document;
+            $self->_read_hash( $document, [ length($1) ], \@lines );
+
+        } else {
+            croak("YAML::Tiny failed to classify the line '$lines[0]'");
+        }
+    }
+
+    $self;
+}
+
+# Deparse a scalar string to the actual scalar
+sub _read_scalar {
+    my ($self, $string, $indent, $lines) = @_;
+
+    # Trim trailing whitespace
+    $string =~ s/\s*\z//;
+
+    # Explitic null/undef
+    return undef if $string eq '~';
+
+    # Quotes
+    if ( $string =~ /^\'(.*?)\'\z/ ) {
+        return '' unless defined $1;
+        $string = $1;
+        $string =~ s/\'\'/\'/g;
+        return $string;
+    }
+    if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
+        # Reusing the variable is a little ugly,
+        # but avoids a new variable and a string copy.
+        $string = $1;
+        $string =~ s/\\"/"/g;
+        $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
+        return $string;
+    }
+
+    # Special cases
+    if ( $string =~ /^[\'\"!&]/ ) {
+        croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
+    }
+    return {} if $string eq '{}';
+    return [] if $string eq '[]';
+
+    # Regular unquoted string
+    return $string unless $string =~ /^[>|]/;
+
+    # Error
+    croak("YAML::Tiny failed to find multi-line scalar content") unless @$lines;
+
+    # Check the indent depth
+    $lines->[0]   =~ /^(\s*)/;
+    $indent->[-1] = length("$1");
+    if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
+        croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
+    }
+
+    # Pull the lines
+    my @multiline = ();
+    while ( @$lines ) {
+        $lines->[0] =~ /^(\s*)/;
+        last unless length($1) >= $indent->[-1];
+        push @multiline, substr(shift(@$lines), length($1));
+    }
+
+    my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
+    my $t = (substr($string, 1, 1) eq '-') ? ''  : "\n";
+    return join( $j, @multiline ) . $t;
+}
+
+# Parse an array
+sub _read_array {
+    my ($self, $array, $indent, $lines) = @_;
+
+    while ( @$lines ) {
+        # Check for a new document
+        if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+            while ( @$lines and $lines->[0] !~ /^---/ ) {
+                shift @$lines;
+            }
+            return 1;
+        }
+
+        # Check the indent level
+        $lines->[0] =~ /^(\s*)/;
+        if ( length($1) < $indent->[-1] ) {
+            return 1;
+        } elsif ( length($1) > $indent->[-1] ) {
+            croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
+        }
+
+        if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
+            # Inline nested hash
+            my $indent2 = length("$1");
+            $lines->[0] =~ s/-/ /;
+            push @$array, { };
+            $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
+
+        } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
+            # Array entry with a value
+            shift @$lines;
+            push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines );
+
+        } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
+            shift @$lines;
+            unless ( @$lines ) {
+                push @$array, undef;
+                return 1;
+            }
+            if ( $lines->[0] =~ /^(\s*)\-/ ) {
+                my $indent2 = length("$1");
+                if ( $indent->[-1] == $indent2 ) {
+                    # Null array entry
+                    push @$array, undef;
+                } else {
+                    # Naked indenter
+                    push @$array, [ ];
+                    $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
+                }
+
+            } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
+                push @$array, { };
+                $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
+
+            } else {
+                croak("YAML::Tiny failed to classify line '$lines->[0]'");
+            }
+
+        } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
+            # This is probably a structure like the following...
+            # ---
+            # foo:
+            # - list
+            # bar: value
+            #
+            # ... so lets return and let the hash parser handle it
+            return 1;
+
+        } else {
+            croak("YAML::Tiny failed to classify line '$lines->[0]'");
+        }
+    }
+
+    return 1;
+}
+
+# Parse an array
+sub _read_hash {
+    my ($self, $hash, $indent, $lines) = @_;
+
+    while ( @$lines ) {
+        # Check for a new document
+        if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+            while ( @$lines and $lines->[0] !~ /^---/ ) {
+                shift @$lines;
+            }
+            return 1;
+        }
+
+        # Check the indent level
+        $lines->[0] =~ /^(\s*)/;
+        if ( length($1) < $indent->[-1] ) {
+            return 1;
+        } elsif ( length($1) > $indent->[-1] ) {
+            croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
+        }
+
+        # Get the key
+        unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
+            if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
+                croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
+            }
+            croak("YAML::Tiny failed to classify line '$lines->[0]'");
+        }
+        my $key = $1;
+
+        # Do we have a value?
+        if ( length $lines->[0] ) {
+            # Yes
+            $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
+        } else {
+            # An indent
+            shift @$lines;
+            unless ( @$lines ) {
+                $hash->{$key} = undef;
+                return 1;
+            }
+            if ( $lines->[0] =~ /^(\s*)-/ ) {
+                $hash->{$key} = [];
+                $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
+            } elsif ( $lines->[0] =~ /^(\s*)./ ) {
+                my $indent2 = length("$1");
+                if ( $indent->[-1] >= $indent2 ) {
+                    # Null hash entry
+                    $hash->{$key} = undef;
+                } else {
+                    $hash->{$key} = {};
+                    $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
+                }
+            }
+        }
+    }
+
+    return 1;
+}
+
+# Set error
+sub _error {
+    $YAML::Tiny::errstr = $_[1];
+    undef;
+}
+
+# Retrieve error
+sub errstr {
+    $YAML::Tiny::errstr;
+}
+
+
+
+#####################################################################
+# Use Scalar::Util if possible, otherwise emulate it
+
+BEGIN {
+    eval {
+        require Scalar::Util;
+    };
+    if ( $@ ) {
+        # Failed to load Scalar::Util
+        eval <<'END_PERL';
+sub refaddr {
+    my $pkg = ref($_[0]) or return undef;
+    if (!!UNIVERSAL::can($_[0], 'can')) {
+        bless $_[0], 'Scalar::Util::Fake';
+    } else {
+        $pkg = undef;
+    }
+    "$_[0]" =~ /0x(\w+)/;
+    my $i = do { local $^W; hex $1 };
+    bless $_[0], $pkg if defined $pkg;
+    $i;
+}
+END_PERL
+    } else {
+        Scalar::Util->import('refaddr');
+    }
+}
+
+
+#####################################################################
+# main test
+#####################################################################
+
+package main;
+
+BEGIN {
+
+    # Skip modules that either don't want to be loaded directly, such as
+    # Module::Install, or that mess with the test count, such as the Test::*
+    # modules listed here.
+    #
+    # Moose::Role conflicts if Moose is loaded as well, but Moose::Role is in
+    # the Moose distribution and it's certain that someone who uses
+    # Moose::Role also uses Moose somewhere, so if we disallow Moose::Role,
+    # we'll still get the relevant version number.
+
+    my %skip = map { $_ => 1 } qw(
+      App::FatPacker
+      Class::Accessor::Classy
+      Devel::Cover
+      Module::Install
+      Moose::Role
+      POE::Loop::Tk
+      Template::Test
+      Test::Kwalitee
+      Test::Pod::Coverage
+      Test::Portability::Files
+      Test::YAML::Meta
+    );
+
+    my $Test = Test::Builder->new;
+
+    $Test->plan(skip_all => "META.yml could not be found")
+        unless -f 'META.yml' and -r _;
+
+    my $meta = (Local::YAML::Tiny->read('META.yml'))->[0];
+    my %requires;
+    for my $require_key (grep { /requires/ } keys %$meta) {
+        my %h = %{ $meta->{$require_key} };
+        $requires{$_}++ for keys %h;
+    }
+    delete $requires{perl};
+
+    diag("Testing with Perl $], $^X");
+    for my $module (sort keys %requires) {
+        if ($skip{$module}) {
+            note "$module doesn't want to be loaded directly, skipping";
+            next;
+        }
+        local $SIG{__WARN__} = sub { note "$module: $_[0]" };
+        use_ok $module or BAIL_OUT("can't load $module");
+        my $version = $module->VERSION;
+        $version = 'undefined' unless defined $version;
+        diag("    $module version is $version");
+    }
+    done_testing;
+}