view release on metacpan or  search on metacpan

utilities/schema_to_perl.pl  view on Meta::CPAN

#!/usr/bin/env perl
#
#
use strict;
use warnings;
use feature qw[unicode_strings switch];
use open ':encoding(utf8)';
no if $] >= 5.018, 'warnings', "experimental::smartmatch";

use Encode;
use File::Basename;
use File::Glob;
use File::Slurp;
use File::Spec;
use IO::File;
use IO::String;
use XML::Twig;
use Data::Dump;

my $request_info = {};
my $type_info    = {};
my $current_set;

# ------------------------------------------------------------------------
sub list {
    return () unless ( defined( $_[0] ) );
    return @{ $_[0] } if ( ref( $_[0] ) eq 'ARRAY' );
    return $_[0];
}

# ----------------------------------------------------------------------
sub build_pod {
    my $info = shift;
    my $twg  = shift;

    # extract documentation and output
    my $docelt = $twg->first_elt('xs:documentation');
    if ($docelt) {
        my $doc = $docelt->text;
        $info->{is_command} = 1 if ( $doc =~ /SuccessResponse/ );

        # condition docs
        $doc =~ tr/\001-\176/ /cs;
        $doc =~ s/^\s{6,}//mg;
        $doc =~ s/\s+$//mg;
        $doc =~ s/^\s\s?(?=\w)/\n/mg;
        $doc =~ s/\s+(?=The\s+response\s+is)/\n\n/mg;
        $doc =~ s/\b(\w+[A-Z][a-z]\w+)\b/C<$1>/g;

        $info->{pod} = $doc;
    }
}

# ----------------------------------------------------------------------
sub build_sub_entry {
    my $out  = shift;
    my $info = shift;

    # output method header with parameters
    $out->printf( "method %s\n(%s)\n{\n", $info->{name}, join( ', ', @{ $info->{input_parameter_names} || [] } ) );

    # output command call
    $out->printf(
        "return \$self->send_%s('%s',\n%s\n);\n}\n",
        ( $info->{is_command} ? 'command' : 'query' ),
        $info->{name}, join( ', ', @{ $info->{output_parameter_map} } )