File Coverage

bin/yfrom

Criterion	Covered	Total	%
statement	58	90	64.4
branch	19	32	59.3
condition	1	2	50.0
subroutine	11	14	78.5
pod			n/a
total	89	138	64.4

#!/usr/bin/env perl
package yfrom;
# ABSTRACT: Build YAML from another format (like JSON or CSV)
$yfrom::VERSION = '0.015';
use App::YAML::Filter::Base;
use Pod::Usage::Return qw( pod2usage );
use Getopt::Long qw( GetOptionsFromArray );
use YAML;
use Module::Runtime qw( use_module );
use Text::Trim qw( ltrim );

$|++; # no buffering

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

    # Have to set the default like this, because it doesn't seem to work in the %opt
    # hash
    $opt{trim} //= 1;

    my $format = shift @argv;
    return pod2usage("ERROR: Must give a format") unless $format;
    return pod2usage("ERROR: Unknown format '$format'")
        unless $class->format_modules( $format );

    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 $f = $class->can_format( $format, %opt )
            or die "Could not load format module for '$format' (tried: "
                . ( join ", ", $class->format_modules( $format ) )
                . ")\n";

        while ( my $line = <$fh> ) {
            my @docs = $f->( $line );
            print YAML::Dump( @docs ) if @docs;
        }
    }

    return 0;
}

my %formatter;

# Hash of "format" => [ MODULE... ]
# The modules are in order we should try to load them, so put the better ones first
my %FORMAT_MODULES = (
    json => [qw( JSON::XS JSON::PP )],
    csv => [qw( Text::CSV_XS Text::CSV )],
);

# Hash of MODULE => formatter sub
sub format_sub {
    my ( $class, $module, %opt ) = @_;

    # Do this to reset the state() variables every time
    my %FORMAT_SUB = (
        'JSON::XS' => sub {
            state $json = JSON::XS->new->relaxed;
            return $json->incr_parse( @_ );
        },

        'JSON::PP' => sub {
            state $json = JSON::PP->new->relaxed;
            return $json->incr_parse( @_ );
        },

        'Text::CSV_XS' => sub {
            state $csv = Text::CSV_XS->new;
            state @names;
            if ( !@names ) {
                $csv->parse( shift );
                @names = $csv->fields;
                return;
            }
            $csv->parse( shift );
            my @values = $csv->fields;
            my $doc = { map {; $names[ $_ ] => $values[ $_ ] } 0..$#values };
            if ( $opt{trim} ) {
                ltrim for values %$doc;
            }
            return $doc;
        },

        'Text::CSV' => sub {
            state $csv = Text::CSV->new;
            state @names;
            if ( !@names ) {
                $csv->parse( shift );
                @names = $csv->fields;
                return;
            }
            $csv->parse( shift );
            my @values = $csv->fields;
            my $doc = { map {; $names[ $_ ] => $values[ $_ ] } 0..$#values };
            if ( $opt{trim} ) {
                ltrim for values %$doc;
            }
            return $doc;
        },

    );

    return $FORMAT_SUB{ $module };
}

sub format_modules {
    my ( $class, $format ) = @_;
    return unless $FORMAT_MODULES{ $format };
    return @{ $FORMAT_MODULES{ $format } };
}

sub can_format {
    my ( $class, $format, %opt ) = @_;
    my $m = $formatter{ $format };
    if ( !$m ) {
        my @modules = $class->format_modules( $format );
        for my $module ( @modules ) {
            if ( eval { use_module( $module ); 1 } ) {
                $m = $module;
                last;
            }
        }
    }
    return $class->format_sub( $m, %opt );
}

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

__END__