Skip to content

Instantly share code, notes, and snippets.

@sycobuny
Created April 23, 2012 17:19
Show Gist options
  • Save sycobuny/2472458 to your computer and use it in GitHub Desktop.
Save sycobuny/2472458 to your computer and use it in GitHub Desktop.
Thoughts on a PLModel (like PGModel but for Perl)
package PLModel::Accessor;
use warnings;
use strict;
sub TIESCALAR {
my ($class) = shift;
my ($curval, $colname, $object) = @_;
return bless({
curval => $curval,
colname => $colname,
object => $object
}, $class);
}
sub FETCH {
my ($self) = shift;
return $self->{curval};
}
sub STORE {
my ($self) = shift;
my ($newval) = @_;
$newval = $self->{object}->set_column($self->{colname}, $newval);
$self->{curval} = $newval;
return $self;
}
1;
package PLModel::Base;
use warnings;
use strict;
use Hash::Util::FieldHash qw(id);
sub load_columns {
my ($self) = shift;
my ($columns) = {};
my ($class) = ref($self) || $self;
# retrieve columns... this following line will stand in for the moment.
$columns = {
text_field => 'asdf',
other_field => 'qwerty',
};
foreach my $colname (keys %$columns) {
no strict 'refs';
my ($method) = $class . '::' . $colname;
unless (*{$method}{CODE}) {
*{$method} = sub : lvalue {
my ($self) = shift;
my ($value);
tie $value, 'PLModel::Accessor', $self->get_column($colname),
$colname, $self;
$value;
};
}
}
}
sub set_column {
my ($self) = shift;
my ($colname, $value) = @_;
$self->{$colname} = $value;
}
sub get_column {
my ($self) = shift;
my ($colname) = @_;
return $self->{$colname};
}
1;
use warnings;
use strict;
use v5.14;
use PLModel::Base;
use PLModel::Accessor;
{
package SomeModel;
our (@ISA) = qw(PLModel::Base);
SomeModel->load_columns();
}
my ($asdf) = bless({}, 'SomeModel');
$asdf->text_field = 'blah';
say $asdf->text_field;

My thinking is that this would work a lot like PGModel, but with Perl (and its much nicer handling of, well, everything) standing in for PHP. The main problem with Perl is handling lvalue subs so that, instead of $someobject->set_column_name($value) and $someobject->column_name(), we could have $someobject->column_name = $value and $someobject->column_name. I'm hoping what I've written here with scalar tying would work.*

From here, it's a function of porting over a lot of the changes from PLModel, so that our eventual code could look something like this:

### Account.pm, for a accounts table in the DB

package Account;
use warnings;
use strict;
use PLModel::Base;

@ISA = qw(PLModel::Base);

1;

### get_birthday_money.pl

use warnings;
use strict;

use Account;

my ($id) = 15;           # my checking account ID!
my ($account) = Account->load($id);
$account->balance += 20; # birthday check from grandma;
$account->save();

1;
  • Update: IT WORKS zOMG~
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment