view release on metacpan or  search on metacpan

etc/make_method  view on Meta::CPAN

        namespace => $attrs{namespace},
        type      => $attrs{type},
        version   => $attrs{version},
        hidden    => $attrs{hidden},
        code      => $attrs{codetxt},
        help      => $attrs{helptxt},
        sigs      => $attrs{siglist},
    }
);

exit 0;

###############################################################################
#
#   Sub Name:       read_from_file
#
#   Description:    Read method data from the given *.base file
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $file     in      scalar    File to read, minus the ".base"
#
#   Globals:        %attrs
#
#   Returns:        Success:    void
#                   Failure:    croaks
#
###############################################################################
sub read_from_file
{
    my $file = shift;

    my ($volume, $path) = File::Spec->splitpath($file);
    $path ||= q{.};

    $attrs{type}      = 'm'; # Default the type to 'm'ethod.
    $attrs{codetxt}   = {};
    $attrs{siglist}   = [];
    $attrs{namespace} = q{};
    $attrs{hidden}    = 0;
    $attrs{version}   = q{};


    my @lines;
    if (open my $fh, '<', "$file.base")
    {
        @lines = <$fh>;
        close $fh or croak "Error closing $file.base: $!\nStopped";
    }
    else
    {
        croak "Error opening $file.base for reading: $!\nStopped";
    }

    for my $line (@lines)
    {
        chomp $line;

        # Skip blanks and comments
        next if ($line =~ /^\s*(?:#.*)?$/);

        # I'm using a horrendous if-else cascade to avoid moving the required
        # version of Perl to 5.012 just for the "when" construct.
        ## no critic (ProhibitCascadingIfElse)
        if ($line =~ /^name:\s+([\w.]+)$/i)
        {
            $attrs{name} = $1;
        }
        elsif ($line =~ /^namespace:\s+([\w.]+)$/i)
        {
            $attrs{namespace} = $1;
        }
        elsif ($line =~ /^type:\s+(\S+)$/i)
        {
            $attrs{type} = substr lc $1, 0, 1;
        }
        elsif ($line =~ /^version:\s+(\S+)$/i)
        {
            $attrs{version} = $1;
        }
        elsif ($line =~ /^signature:\s+\b(.*)$/i)
        {
            push @{$attrs{siglist}}, $1;
        }
        elsif ($line =~ /^hidden:\s+(no|yes)/i)
        {
            $attrs{hidden} = (lc $1 eq 'yes') ? 1 : 0;
        }
        elsif ($line =~ /^helpfile:\s+(.*)/i)
        {
            $attrs{helptxt} =
                read_external(File::Spec->catpath($volume, $path, $1));
        }
        elsif ($line =~ /^codefile(?:\[(.*)\])?:\s+(.*)/i)
        {
            $attrs{codetxt}->{$1 || 'perl'} =
                read_external(File::Spec->catpath($volume, $path, $2));
        }
    }
    if (! keys %{$attrs{codetxt}})
    {
        croak "Error: no code specified in $opts{base}.base, stopped";
    }
    if (! @{$attrs{siglist}})
    {
        croak "Error: no signatures found in $opts{base}.base, stopped";
    }

    return;
}

###############################################################################
#
#   Sub Name:       read_from_opts
#
#   Description:    Read method data from the command-line options
#
#   Arguments:      None.
#
#   Globals:        %opts
#                   %attrs
#