ryo0ka has asked for the wisdom of the Perl Monks concerning the following question:

Hello Monks, I have a weird question.

My String module has a hash reference: 

$reg = {
    url  => qr[^http://],
};

[download]
and has an AUTOLOAD subroutine: 
sub AUTOLOAD {
    our $AUTOLOAD;
    my $arg = shift;

    if ($AUTOLOAD =~ /^is_/) {
        my $key = substr $AUTOLOAD, 3;
        my $val = $reg->{$val};
        return 1 if $arg =~ /$val/;
    }
}

[download]
so I can use "is_**" subroutine and add new regix whenever I want, for example, I add like: 
$reg = {
    url  => qr[^http://],
    file => qr[^[a-Z]:/],
};

[download]
so I can use "is_file" subroutine.

Then, to avoid typing String::is_url($str) but just is_url($str) on another file, I want to export "is***" subroutine by using Export.

To do so, I added this code: 

use Export;

our @EXPORT = do {
    no strict 'refs';
    grep {*$_{CODE}} keys %Str::;
};

[download]
But it does not load AUTOLOADed subroutine "is_**" because it will be loaded when it's called.

Are there any way to call "is_***" without "String::" from another module?

Thanks in advance!

Replies are listed 'Best First'.
Re: How to export un-exist subroutines
by Corion (Patriarch) on May 26, 2013 at 15:29 UTC

    You don't even need AUTOLOAD, just create the subroutine when the other module wants to import it. Exporter is not the ideal tool for that:

    sub import {
    my( @wanted )= @_;
    my( $target )= caller;

    for my $name (@wanted) {
        no strict 'refs';
        
        my $key= substr $name, 3; # is_${key}
        "$target\::$name" = sub {
            my( $reg ) = @_;
            ...
        };
    };
};

    [download]
[reply]
[d/l]
[select]
Re: How to export un-exist subroutines
by tobyink (Canon) on May 26, 2013 at 18:45 UTC

    Here's a metaprogramming solution... Instead of directly added regexps to the hash, we use a helper sub add_regexp to do it. add_regexp also does a little housework, including creating a sub for us (so there's no longer any need to use AUTOLOAD), and adding the name of that sub to @EXPORT_OK.

    #!/usr/bin/env perl

use strict;
use warnings;

BEGIN {
    package String;
    use Carp;

    our @ISA = "Exporter";
    $INC{"String.pm"} = __FILE__;
    
    {
        my %reg;
        sub get_regexp {        $reg{$_[1]} }
        sub has_regexp { exists $reg{$_[1]} }
        sub add_regexp {
            my $class = shift;
            my ($name, $re) = @_;
            croak "Already exists: $_[0]" if $class->has_regexp($name)
+;
            $reg{$name} = $re;
            no strict "refs";
            *{"is_$name"} = sub { !!($_[0] =~ $re) };
            push our @EXPORT_OK, "is_$name";
        }
    }
    
    __PACKAGE__->add_regexp(Url => qr[^http:]);
    __PACKAGE__->add_regexp(SecureUrl => qr[^https:]);
};

use String qw(is_SecureUrl);

print is_SecureUrl("https://github.com/"), "\n";

    [download]

    Or, because I like to pimp Type::Tiny...

    #!/usr/bin/env perl

use strict;
use warnings;

BEGIN {
    package String;
    use Type::Library -base;
    use Type::Utils;
    use Types::Standard qw(StrMatch);

    $INC{"String.pm"} = __FILE__;
    
    declare "Url", as StrMatch[qr(^http:)];
    declare "SecureUrl", as StrMatch[qr(^https:)];
};

use String -all;

print is_SecureUrl("https://github.com/"), "\n";

assert_SecureUrl("http://evil.com/");

    [download]

    In the spirit of full disclosure, I'll point out that I've changed your regexps slightly because Type::Tiny seems to have a few bugs compiling regexps containing slashes. I'll need to find a fix for that. :-/

    Update: fixed in repo.

    package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name
[reply]
[d/l]
[select]
      Thank you guys, I just figured out the way after long trial with myself from when I post this topic to right now without any break: 
      foreach (keys %$reg) {
    no strict 'refs';
    my $regkey = $_ or next;
    my $regval = $reg->{$regkey} or next;
    my $sub = sub {
        return 1 if shift =~ /$regval/;
    };
    *{'is_'.$regkey} = $sub;
}

our @EXPORT = do {
    no strict 'refs';
    my @list;
    foreach (keys %Str::) {
        eval {my $sub = *$_{CODE};};
        push @list, $_ if !$@;
    }
    @list;
};

      [download]
      I did not need AUTOLOAD at all. Thank you again, I'm going to read your answers from now!
[reply]
[d/l]

Back to Seekers of Perl Wisdom