This is commonly called a "Role". It's usually implemented in Perl either by simply importing methods as if they were (well, they are) subroutines, or by multiple inheritance, with the hope that no bad diamond inheritance problems get created.

See Role::Tiny, Moo::Role, Algorithm::C3, and likely Role.

Most Perl modules also use a function/method/"keyword" named with for declaring such roles/mixins.

Sorry but I don't see how to realize my concept with roles ,especially with the modules you mentioned. (?)

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery FootballPerl is like chess, only without the dice}

Aaah, sorry - I misread/misunderstood what you wanted to do.

A global version of what you seem to want to do is Object::Import, which exports some or all methods of a (default) object and makes them available as functions:

use Object::Import $object;
foo(@bar); # now means $object->foo(@bar);
[download]

The module does not act on a lexical scope though, and I'm not sure what a good way would be to save/restore this lexical scope. I would expect parsing mishaps / parsing confusion for Perl if you redefine subroutine bindings based on the dynamic scope, and I don't see any better way to implement something like this in Perl, unless you implement something like the Javascript version of with as well. Importing dynamically is easy:

{
    my $object = Foo::Bar->new();
    import Object::Import $object; # Make all methods of $object avail
+able as functions
}
[download]

The hard part is unimporting stuff, and you could do that by localizing your namespace every time you import an object, but that will be weird if you actually try to change your namespace:

#!perl
use strict;
use warnings;

package Foo::Bar;
sub frobnitz {
    print "frobnitz in " . __PACKAGE__ . "\n";
};

package Foo::Whatever;
use strict;
use warnings;
require Object::Import;
sub frobnitz {
    print "frobnitz in " . __PACKAGE__ ."\n";
};

frobnitz();
{
    local *Foo::Whatever::frobnitz;
    my $object = {};
    bless $object => "Foo::Bar";
    Object::Import->import( $object, list => ['frobnitz'], nowarn_rede
+fine => 1 ); # Make all methods of $object available as functions
    frobnitz(); # call $object->frobnitz();
}
frobnitz();

__END__
frobnitz in Foo::Whatever
frobnitz in Foo::Bar
frobnitz in Foo::Whatever
[download]

In the above, I localize frobnitz(), but the hard part will be to make that localization non-local when putting all of that in a subroutine with. Maybe namespace::autoclean has a hint on how to implement something like this.

If you don't care that much about restoring the dynamic namespace/scope again, Object::Import should already work.

Hmmm, it's an interesting idea. I poked around CPAN searching for "curry" in hope, but nothing quite like what you wanted. Personally, I think something like this isn't too bad, for small scopes at least:

for ($object) {
  $_->log("blah");
}
[download]

But yeah, you could certainly implement it in probably only a few lines of code, using Exporter::Lexical and curry.

This works. It actually works better without curry because then you don't need $object to be defined yet at compile-time.

use 5.018;
use strict;
use warnings;

BEGIN {
    package Foo;
    use Moo;
    sub meth {
        die unless ref shift;
        join "|", @_;
    }
    sub othermeth {
        die unless ref shift;
        join ":", @_;
    }
    $INC{'Foo.pm'} = __FILE__;
};

BEGIN {
    package curry::lexical;
    use Exporter::Lexical ();
    use Exporter::Tiny ();
    sub import {
        my $me      = shift;
        my $objref  = shift;
        my $optlist = Exporter::Tiny::mkopt(\@_);
        for my $method (@$optlist) {
            my ($name, $currystuff) = @$method;
            my ($originalname, @args) = ref($currystuff) ? @$currystuf
+f : $name;
            my $coderef = sub { $$objref->$originalname(@args, @_) };
            Exporter::Lexical::lexical_import($name, $coderef);
        }
    }
    $INC{'curry/lexical.pm'} = __FILE__;
};

use Test::More;

sub meth { "FUNCTION" }

is meth("foo"), "FUNCTION";

{
    my $obj = Foo->new;
    use curry::lexical \$obj, "meth", "meth2" => ["meth", "prefix"], "
+othermeth";
    
    is meth("foo"), "FUNCTION", "non-lexical sub wins";
    is meth2("foo"), "prefix|foo";
    is othermeth("foo", "bar"), "foo:bar";
}

is meth("foo"), "FUNCTION";

done_testing;
[download]

So with your example, you could do something like:

my $app = MyApp->new;

{
  use curry::lexical \$app, qw(log foo bar), critical_log => [log => "
+CRITICAL"];
 
  log("Hi");         # $app->log("Hi");
  foo();             # $app->foo();
  bar(123);          # $app->bar(123);
  critical_log();    # $app->log("CRITICAL");
}
[download]

The functions imported via curry::lexical cannot overwrite "normal" functions, as shown in the second test of the test script.

toby döt ink

Autoload tries then to call any missing sub via $WITH->sub

$WITH can be easily localized to scope the effects.

More sophisticated configurations like importing only dedicated methods or methods from different objects could be achieved by allowing $WITH to hold array or hashes or even be tied or blessed into a config object or all off the former.

use strict;
use warnings;
use Carp;


=head1 Method::Load

Exports an AUTOLOAD routine and a package var $WITH which holds an obj
+ect.

Any unknown calls 'name' will trigger $WITH->name();

A clean implementation should check if $WITH->can(name) is missing 
If an older AUTOLOAD already exists, delegate there 
otherwise report error from users package. 

=cut

package Method::Load;
use Data::Dump qw/pp dd/;

BEGIN { $INC{"Method/Load.pm"} = 1; } # hack: already required
use vars qw/$AUTOLOAD/;


sub import {
    my $import_pkg = (caller)[0];
    no strict 'refs';
    my $with;
    *{"${import_pkg}::WITH"} = \$with;
    *{"${import_pkg}::AUTOLOAD"}=\&autoload;
    
}

sub autoload {
    my ($pkg,$sub) = split /::/, $AUTOLOAD;
    #warn "AUTOLOAD: ", pp [$pkg,$sub ];

    my $obj;
    {
        no strict 'refs';
        $obj = ${"${pkg}::WITH"};
    }
    
    if (1) {
        $obj->$sub(@_);
    } else {                            # hide autoload from caller-ch
+ain
        my $c_ref = $obj->can($sub);
        unshift @_,$obj;
        goto &$c_ref;     
    }

}


=head1 Demo classes


=cut

package Delegate::Bar;
use Data::Dump qw/pp dd/;

sub bar {
    #warn pp [@_];
    my ($self,@args) = @_;
    Carp::cluck pp [$self->{args},@args];
}

sub new {
    my ($class,@args) =@_;
    return bless {args => \@args}, $class;
}

package Delegate::Foo;
use Data::Dump qw/pp dd/;

sub foo {
    #warn pp [@_];
    my ($self,@args) = @_;
    Carp::cluck pp [$self->{args},@args];
}

sub new {
    my ($class,@args) =@_;
    return bless {args => \@args}, $class;
}

    

=head1 Proof Of Concept

=cut


package Test;
use Method::Load;

my $obj= Delegate::Foo->new("is foo");

$obj->foo(0);

$WITH = $obj;                           # set globally

foo(1);


{
    local $WITH = Delegate::Bar->new("is bar");
    bar(2);
}

foo(3);
bar(4);                                  # fails
[download]

OUTPUT:

[["is foo"], 0] at d:/exp/t_Method_Load.pl line 77.
    Delegate::Foo::foo(Delegate::Foo=HASH(0x2dbc388), 0) called at d:/
+exp/t_Method_Load.pl line 100
[["is foo"], 1] at d:/exp/t_Method_Load.pl line 77.
    Delegate::Foo::foo(Delegate::Foo=HASH(0x2dbc388), 1) called at d:/
+exp/t_Method_Load.pl line 42
    Method::Load::autoload(1) called at d:/exp/t_Method_Load.pl line 1
+04
[["is bar"], 2] at d:/exp/t_Method_Load.pl line 63.
    Delegate::Bar::bar(Delegate::Bar=HASH(0x4574b10), 2) called at d:/
+exp/t_Method_Load.pl line 42
    Method::Load::autoload(2) called at d:/exp/t_Method_Load.pl line 1
+09
[["is foo"], 3] at d:/exp/t_Method_Load.pl line 77.
    Delegate::Foo::foo(Delegate::Foo=HASH(0x2dbc388), 3) called at d:/
+exp/t_Method_Load.pl line 42
    Method::Load::autoload(3) called at d:/exp/t_Method_Load.pl line 1
+12
Can't locate object method "bar" via package "Delegate::Foo" at d:/exp
+/t_Method_Load.pl line 42.
[download]

It looks like you've a singleton 'app' and it's been passed around to invoke methods. Normally this sounds like where DI is used? even thought DI would still require you to write $obj->method. Below idea could work. but I'm not really expert in the magical part of Perl. :)

sub _get_instance {
   ... init singleton if not created yet.
   return $app;
}
sub log {
# well there should be some easy way to somehow create function that f
+orwards to singleton
   my $app = &_get_instance;
   $app->log(@_);
}
[download]

(I suppose DI means Dependency injection)

No it's not a singleton, there are (<10%) cases where I need more than one object.

Otherwise I'd use a normal module.

That's why I need a mechanism for the remaining 90% to use a normal Class like a singleton module.

My interpretation:

From a Java OOP point of view Perl's module/package architecture could be understood as Singleton classes and the import routine as the constructor and package vars as class/instance variables (singleton means class=instance)

Lexical scoping of a modules effects are crucial to avoid global conflicts.

These things are hard to discuss because of little incompatibilities between languages.

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery FootballPerl is like chess, only without the dice}