File Coverage

bin/yq

Criterion	Covered	Total	%
statement	69	73	94.5
branch	23	28	82.1
condition	4	6	66.6
subroutine	13	13	100.0
pod			n/a
total	109	120	90.8

#!/usr/bin/env perl
package yq;
# ABSTRACT: Filter YAML through a command-line program
$yq::VERSION = '0.014';
use App::YAML::Filter::Base;
use Pod::Usage::Return qw( pod2usage );
use Getopt::Long qw( GetOptionsFromArray );
use YAML;
use boolean qw( :all );
use Module::Runtime qw( use_module );

$|++; # no buffering

our $VERBOSE = $ENV{YQ_VERBOSE} // 0;

sub is_empty {
    return ref $_[0] eq 'empty';
}

sub main {
    my ( $class, @argv ) = @_;
    my %opt;
    GetOptionsFromArray( \@argv, \%opt,
        'help|h',
        'verbose|v+',
        'version',
    );
    return pod2usage(0) if $opt{help};
    if ( $opt{version} ) {
        print "yq version $yq::VERSION (Perl $^V)\n";
        return 0;
    }

    $VERBOSE //= $opt{verbose};

    my $filter = shift @argv;
    return pod2usage("ERROR: Must give a filter") unless $filter;

    push @argv, "-" unless @argv;
    for $ARGV ( @argv ) {
        # We're doing a similar behavior to <>, but manually for easier testing.
        my $fh;
        if ( $ARGV eq '-' ) {
            # Use the existing STDIN so tests can fake it
            $fh = \*STDIN;
        }
        else {
            unless ( open $fh, '<', $ARGV ) {
                warn "Could not open file '$ARGV' for reading: $!\n";
                next;
            }
        }

        my $buffer;
        my $scope = {};
        while ( my $line = <$fh> ) {
            # --- is the start of a new document
            if ( $buffer && $line =~ /^---/ ) {
                # Flush the previous document
                my @output = $class->filter( $filter, YAML::Load( $buffer ), $scope );
                $class->write( @output );
                $buffer = '';
            }
            $buffer .= $line;
        }
        # Flush the buffer in the case of a single document with no ---
        if ( $buffer =~ /\S/ ) {
            #print STDERR "Buffer is: $buffer\n";
            my @output = $class->filter( $filter, YAML::Load( $buffer ), $scope );
            $class->write( @output );
        }

        # Finish the scope, cleaning up any collections
        $class->write( $class->finish( $scope ) );
    }

    return 0;
}

sub write {
    my ( $class, @docs ) = @_;
    for my $doc ( @docs ) {
        next if is_empty( $doc );
        if ( isTrue( $doc ) ) {
            print YAML::Dump( "true" );
        }
        elsif ( isFalse( $doc ) ) {
            print YAML::Dump( "false" );
        }
        else {
            print YAML::Dump( $doc );
        }
    }
}

sub diag {
    my ( $level, $text ) = @_;
    print STDERR "$text\n" if $VERBOSE >= $level;
}

$ENV{YQ_CLASS} ||= 'App::YAML::Filter::Regex';
use_module( $ENV{YQ_CLASS} );
{
    no strict 'refs';
    no warnings 'once';
    *filter = *{ $ENV{YQ_CLASS} . "::filter" };
}

sub finish {
    my ( $class, $scope ) = @_;
    if ( $scope->{sort} ) {
        return map { $_->[1] } sort { $a->[0] cmp $b->[0] } @{ $scope->{sort} };
    }
    elsif ( $scope->{group_by} ) {
        return $scope->{group_by};
    }
    return;
}

exit __PACKAGE__->main( @ARGV ) unless caller(0);

__END__