view release on metacpan or  search on metacpan

lib/Beam/Runner/Command/list.pm  view on Meta::CPAN

    if ( !$class->_list_services( $container ) ) {
        warn qq{No runnable services in container "$container"\n};
        return 1;
    }

    return 0;
}

#=sub _list_containers
#
#   my $exit = $class->_list_containers
#
# Print all the containers found in the BEAM_PATH to STDOUT
#
#=cut

sub _list_containers {
    my ( $class ) = @_;
    die "Cannot list containers: BEAM_PATH environment variable not set\n"
        unless $ENV{BEAM_PATH};

    my %containers = find_containers();
    my @container_names = sort keys %containers;
    my $printed = 0;
    for my $i ( 0..$#container_names ) {
        if ( $printed ) {
            print "\n";
            $printed = 0;
        }
        $printed += $class->_list_services( $containers{ $container_names[ $i ] } );
    }

    return 0;
}

#=sub _list_services
#
#   my $exit = $class->_list_services( $container );
#
# Print all the runnable services found in the container to STDOUT
#
#=cut

sub _list_services {
    my ( $class, $container ) = @_;
    my $path = find_container_path( $container );
    my $cname = $path->basename( @EXTS );
    my $wire = Beam::Wire->new(
        file => $path,
    );

    my $config = $wire->config;
    my %services;
    for my $name ( keys %$config ) {
        my ( $name, $abstract ) = _list_service( $wire, $name, $config->{$name} );
        next unless $name;
        $services{ $name } = $abstract;
    }
    return 0 unless keys %services;

    my ( $bold, $reset ) = ( color( 'bold' ), color( 'reset' ) );
    print "$bold$cname$reset" . ( eval { " -- " . $wire->get( '$summary' ) } || '' ) . "\n";

    my $size = max map { length } keys %services;
    print join( "\n", map { sprintf "- $bold%-${size}s$reset -- %s", $_, $services{ $_ } } sort keys %services ), "\n";
    return 1;
}

#=sub _list_service
#
#   my $service_info = _list_service( $wire, $name, $config );
#
# If the given service is a runnable service, return the information
# about it ready to be printed to STDOUT. $wire is a Beam::Wire object,
# $name is the name of the service, $config is the service's
# configuration hash
#
#=cut

sub _list_service {
    my ( $wire, $name, $svc ) = @_;

    # If it doesn't look like a service, we don't care
    return unless $wire->is_meta( $svc, 1 );

    # Services that are just references to other services should still
    # be available under their referenced name
    my %svc = %{ $wire->normalize_config( $svc ) };
    if ( $svc{ ref } ) {
        my $ref_svc = $wire->get_config( $svc{ ref } );
        return _list_service( $wire, $name, $ref_svc );
    }

    # Services that extend other services must be resolved to find their
    # class and roles
    my %merged = $wire->merge_config( %svc );
    #; use Data::Dumper;
    #; print "$name merged: " . Dumper \%merged;
    my $class = $merged{ class };
    my @roles = @{ $merged{ with } || [] };

    # Can we determine this object is runnable without loading anything?
    if ( grep { $_ eq 'Beam::Runnable' } @roles ) {
        return _get_service_info( $name, $class, \%merged );
    }

    if ( eval { any {; use_module( $_ )->DOES( 'Beam::Runnable' ) } $class, @roles } ) {
        return _get_service_info( $name, $class, \%merged );
    }

    return;
}

#=sub _get_service_info( $name, $class )
#
#   my ( $name, $abstract ) = _get_service_info( $name, $class, $config );
#
# Get the information about the given service. Opens the C<$class>
# documentation to find the class's abstract (the C<=head1 NAME>
# section). If C<$config> contains a C<summary> in its C<args> hashref,
# will use that in place of the POD documentation.
#
#=cut

sub _get_service_info {