view release on metacpan or  search on metacpan

lib/Astro/App/Satpass2/Macro/Code.pm  view on Meta::CPAN

package Astro::App::Satpass2::Macro::Code;

use 5.008;

use strict;
use warnings;

use parent qw{ Astro::App::Satpass2::Macro };

use Astro::App::Satpass2::Utils qw{
    expand_tilde
    load_package
    quoter
    @CARP_NOT
};
use File::Spec;

our $VERSION = '0.058';

sub init {
    my ( $self ) = @_;
    $self->SUPER::init();
    my $parent = $self->parent();
    my %popt = ( complaint => 'wail', fatal => 'wail' );
    exists $self->{lib}
	and $popt{lib} = $self->expand_tilde( $self->{lib} );
    defined $self->{lib}
	and not $self->{relative}
	and not $self->{lib} =~ m/ \A ~ /smx
	and $self->{lib} = File::Spec->rel2abs( $self->{lib} );
    my $module = $self->load_package(
	\%popt, $self->name(), 'Astro::App::Satpass2::Macro::Code'
    );
    $module->isa( 'Astro::App::Satpass2' )
	or $self->wail( "$module is not a subclass of Astro::App::Satpass2" );

    my %implements;		# Names and references to found code
    my $stb = "${module}::";	# Name of loaded symbol table

    # Fairly deep magic begins here. We need symbolic references to
    # traverse the symbol table of the loaded code, so:
    no strict qw{ refs };

    foreach my $name ( keys %$stb ) {
	my $val = $stb->{$name};

	# We are only interested in symbols that start with alphabetics.
	$name =~ m/ \A [[:alpha:]] /smx
	    or next;

	# We do not want symbols unless they contain at least one
	# lower-case character.
	$name =~ m/ [[:lower:]] /smx
	    or next;

	# We need a reference to the entry's glob, which we obtain by
	# symbolic reference.
	my $glob = \$val;

	# If $name refers to an inlineable function, $val is going to be
	# its value. This is not what we want, so ...
	'GLOB' eq ref $glob
	    or next;

	# If the code slot is empty we ignore it.
	*{$glob}{CODE}
	    or next;

	# If the code does not have the Verb() attribute, we ignore it.
	# TODO technically we have an encapsulation failure here which
	# needs to be fixed up.
	$parent->__get_attr( *{$glob}{CODE}, 'Verb' )
	or next;

	# Record the fact that the module defines this name.
	$implements{$name} = *{$glob}{CODE};
    }

    # End of symbol table magic.
    $self->{implements} = \%implements;
    return;
}

sub execute {
    my ( $self, $name, @args ) = @_;
    my $code = $self->implements( $name, required => 1 );
    return $code->( $self->parent(), @args );
}

sub has_lib {
    my ( $self ) = @_;
    return exists $self->{lib};
}

sub lib {
    my ( $self ) = @_;
    return $self->{lib};
}

sub relative {
    my ( $self ) = @_;
    return $self->{relative};
}

1;

__END__

=head1 NAME

Astro::App::Satpass2::Macro::Code - Implement code as macros

=head1 SYNOPSIS

No user-serviceable parts inside.

=head1 DESCRIPTION

This class is private to the C<Astro-App-Satpass2> distribution, mostly
because the code interface has not been written.

=head1 METHODS

This class provides or overrides the following methods:

=head2 execute

 $macro->execute( $name, @argv );

This method executes the named code, which must be findable via
C<< $macro->implements( $name ) >>. The code will be passed the parent
C<Astro::App::Satpass2> object as its first argument, and C<@argv> as
subsequent arguments. Whatever it returns will be returned to the
caller.

=head2 has_lib

This method returns true if the C<lib> attribute was specified when the
class was created.

=head2 init

This method treats the C<name> attribute as the name of a module to be
loaded (either with or without C<'Astro::App::Satpass2::Macro::Code::'>
prepended). This module must be a subclass of C<Astro::App::Satpass2>.
The loaded module's symbol table is examined, and the C<implements>
attribute is populated with names of and references to any code that has
the C<Verb> attribute.

Note that this means the C<implements( $name )> method returns a
reference to the implementing code if C<$name> is actually implemented;
but users of this module should not rely on this behavior.

=head1 ATTRIBUTES

This class redefines or adds the following attributes of its superclass:

=over

=item lib

This is the name of a directory to be added to C<@INC> before loading
the Perl module that contains the macros. Tilde expansion will be done
on the value. The default is F<lib/> in the user's configuration
directory. If the value is C<undef>, nothing is added to C<@INC> before
the load.

The value of this attribute can be retrieved by the same-named method,
but since this returns C<undef> if this attribute was unspecified as
well as if it was explicitly specified as C<undef>, you should use the
C<has_lib()> method if the difference is important to your code.

=item name

This is the name of the Perl module containing the desired code macros.

=item relative

If this attribute is true, the value of the C<-lib> option, if any, is
left untouched. Otherwise, it is made into an absolute file reference
unless it begins with a tilde.

This is really only here to make testing easier.

=back

=head1 SEE ALSO

The superclass,
L<Astro::App::Satpass2::Macro|Astro::App::Satpass2::Macro>.

=head1 SUPPORT

Support is by the author. Please file bug reports at
L<https://github.com/trwyant/perl-Astro-App-Satpass2/issues> or in
electronic mail to the author.

=head1 AUTHOR

Thomas R. Wyant, III F<harryfmudd at comcast dot net>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013-2026 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the files F<LICENSE-Artistic> and F<LICENSE-GPL>.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :