https://github.com/hoytech/object-sub
Create objects without those pesky classes
https://github.com/hoytech/object-sub
Last synced: 3 months ago
JSON representation
Create objects without those pesky classes
- Host: GitHub
- URL: https://github.com/hoytech/object-sub
- Owner: hoytech
- Created: 2015-04-23T02:25:16.000Z (about 10 years ago)
- Default Branch: master
- Last Pushed: 2017-03-06T17:03:22.000Z (over 8 years ago)
- Last Synced: 2025-01-25T05:43:02.483Z (4 months ago)
- Language: Perl
- Size: 13.7 KB
- Stars: 2
- Watchers: 4
- Forks: 2
- Open Issues: 0
-
Metadata Files:
- Readme: README.pod
- Changelog: Changes
Awesome Lists containing this project
README
package Object::Sub;
use strict;
our $VERSION = '0.103';
our $AUTOLOAD;
use overload fallback => 1,
'&{}' => sub {
my $self_ref = \$_[0];
return sub {
return $$self_ref->{__object_sub_internal_cb}->($$self_ref, undef, @_);
};
};
sub AUTOLOAD {
die "$_[0] is not an object" if !ref $_[0];
my $name = $AUTOLOAD;
$name =~ s/.*://;
return $_[0]->{__object_sub_internal_cb}->($_[0], $name, @_[1 .. $#_]);
}
sub new {
my ($class, $cb) = @_;
if (ref $cb eq 'HASH') {
my $orig_cb = $cb;
$cb = sub {
($orig_cb->{$_[1]} || die "unable to find method $_[1]")->($_[0], @_[2 .. $#_]);
};
}
die "need a callback" if ref $cb ne 'CODE';
my $self = { __object_sub_internal_cb => $cb, };
bless $self, $class;
return $self;
}
## Prevent DESTROY method from being handled by AUTOLOAD
sub DESTROY {
}
1;
__END__
=encoding utf-8
=head1 NAME
Object::Sub - Create objects without those pesky classes
=head1 SYNOPSIS
use Object::Sub;
my $obj = Object::Sub->new(sub {
my ($self, $method, @args) = @_;
print "self: $self, method name: $method, first arg: $args[0]\n";
});
$obj->whatever(123);
## self: Object::Sub=HASH(0xc78eb0), method name: whatever, first arg: 123
$obj->(123);
## self: Object::Sub=HASH(0xc78eb0), method name: , first arg: 123
## ($method is undef)
Alternatively, you can use a hash of subs:
my $obj = Object::Sub->new({
add => sub {
my ($self, $num1, $num2) = @_;
return $num1 + $num2;
},
mul => sub {
my ($self, $num1, $num2) = @_;
return $num1 * $num2;
},
});
$obj->add(2, 3);
## => 5
=head1 DESCRIPTION
Sometimes you want something that acts like an object but you don't want to go to all the trouble of creating a new package, with constructor and methods and so on. This module is a trivial wrapper around perl's L functionality which intercepts method calls and lets you handle them in a single C. It also uses L so that you can additionally treat the object as a C if you desire.
=head1 USE-CASES
=head2 AUTOLOAD SYNTACTIC SUGAR
L allows you to dispatch on method names at run-time which can sometimes be useful, for example in RPC protocols where you transmit method call messages to another process for them to be executed remotely. Unfortunately, using L is a bit annoying since the interface is somewhat arcane. L is a nicer interface to the most commonly used AUTOLOAD functionality:
my $obj = Object::Sub->new(sub {
my ($self, $method, @args) = @_;
my $rpc_input = encode_json({ method => $method, args => [ @args ] });
my $rpc_output = do_rpc_call($rpc_input);
return decode_json($rpc_output);
});
Because C objects can also be treated as subs, your RPC interface can support sub-routine calls on the objects as well as method calls, even on the same object.
=head2 PLACE-HOLDER OBJECTS
Some APIs require you to pass in or provide an object but then don't actually end up using it. Instead of passing in undef and getting a weird C error, you can pass in an L which will throw a "helpful" exception instead:
my $obj = Some::API->new(
logger => Object::Sub->new(sub { die "FIXME: add logger" }),
);
Alternatively, you may choose to minimally implement the API "inline" in your program:
my $obj = Some::API->new(
logger => Object::Sub->new(sub {
my ($self, $method, @args) = @_;
return if $method eq 'debug';
say STDERR "Some::API $method: " . join(' ', @args);
})
);
=head2 LAZY OBJECT CREATION
Again, some APIs may never end up using an object so you may wish to "lazily" defer the creation of that object until a method is actually called on it. This module can help you make the cases where it doesn't use it more efficient.
For example, suppose you have a large L script which always opens a L connection but only actually accesses this connection for a small portion of runs. You can prevent the script from accessing the database on the majority of runs with L:
my $dbh = Object::Sub->new(sub {
require DBI;
$_[0] = DBI->connect($dsn, $user, $pass, { RaiseError => 1 })
|| die "Unable to connect to database: $DBI::errstr";
my ($self, $method, @args) = @_;
return $self->$method(@args);
});
Note how we don't even load or compile the module until the first method is called. After you call a method on C<$dbh> it changes from a C object into a C object (assuming the C<< DBI->connect >> constructor succeeds). This works because the C<$_[0]> argument is actually an alias to C<$dbh> and can be modified.
To demonstrate this, here is an example with L:
my $o = Object::Sub->new(sub {
require Session::Token;
$_[0] = Session::Token->new;
my ($self, $method, @args) = @_;
return $self->$method(@args);
});
say ref $o;
## Object::Sub
say $o->get;
## mhDPtfLlFMGl5kyNcJgFt7
say ref $o;
## Session::Token
say $o->get;
## 4JYkGgwWbYWGleU7Qk912P
With L you can lazily "create" and pass around objects before their constructor code has even been loaded.
=head1 BUGS
Although not really a bug in this module, common perl code tends to copy references of objects. Any code that overwrites the caller object (for example in the L section) will only update one of the copies.
=head1 SEE ALSO
L
=head1 AUTHOR
Doug Hoyte, C<< >>
=head1 COPYRIGHT & LICENSE
Copyright 2015-2016 Doug Hoyte.
This module is licensed under the same terms as perl itself.