I can add to ::oo::define to add global tclOO class definition extensions, how can I do this non-globally? - class

I have found some TclOO resources that mention you can create subclasses of ::oo::class. You can also create bare objects using ::oo::object create, but you cannot migrate from a bare class to a real class (ie parent oo::object to parent oo::class)
I'm looking to create a DSL for defining modules, that just creates class definitions.
module create mysql 5.5 {
executable mysqld
method post_install { ... }
}
module create redis 2.6 {
executable redis-server
...
}
These could then be used as
set mod [mysql new]
$mod install
$mod post_install

While you can't make class-specific extension commands directly in the oo::define system, you can do the next-best-thing very easily. The trick is to use namespace path to profile-in the additional commands to the namespace just for the duration of the definition processing. Which is somewhat over-fancy way of saying that it's pretty easy in metaclass constructors to do this sort of stuff:
# First, build the definition of the extensions
namespace eval ::ModuleDefineExtensions {
proc executable {program} {
# I'm not quite sure how you want to handle this, but [uplevel] and
# [info level] will reveal what you need.
puts "define executable as $program here"
}
}
# Now, the [module] metaclass
oo::class create module {
superclass oo::class
constructor {definitionScript} {
# Save the old path
set oldpath [namespace eval ::oo::define {namespace path}]
# Set the new one
namespace eval ::oo::define {namespace path ::ModuleDefineExtensions}
# Now let the superclass constructor handle this, trapping errors
catch {next $definitionScript} msg opt
# Restore the old path
namespace eval ::oo::define [list namespace path $oldpath]
# Rethrow any errors
return -options $opt $msg
}
}
You probably need some more bits and pieces (e.g., a suitable default superclass of module classes that defines common methods) but those are conventional.
If you're using 8.6, the module definition can be simpler (this time without comments):
oo::class create module {
superclass oo::class
constructor {definitionScript} {
set oldpath [namespace eval ::oo::define {namespace path}]
namespace eval ::oo::define {namespace path ::ModuleDefineExtensions}
try {
next $definitionScript
} finally {
namespace eval ::oo::define [list namespace path $oldpath]
}
}
}
It's the same in principle, but uses the try/finally command of 8.6.

Related

Namespacing in coffeescript

Is there any intrinsic support for namespacing in coffeescript?
Adequate namespacing seems like something coffeescript could really help with although I don't seem to be able to find anything to suggest that there is support for this.
I prefer using this pattern for "namespacing". It isn't really a namespace but an object tree, but it does the job:
Somewhere in the startup of the app, you define the namespaces globally (replace window with exports or global based on your environment.
window.App =
Models: {}
Collections: {}
Views: {}
Then, when you want to declare classes, you can do so:
class App.Models.MyModel
# The class is namespaced in App.Models
And when you want to reference it:
myModel = new App.Models.MyModel()
If you don't like the global way of defining namespaces, you can do so before your class:
window.App.Models ?= {} # Create the "namespace" if Models does not already exist.
class App.Models.MyModel
A way to make it simple to reference the class both in it's own "namespace" (the closed function) and the global namespace is to assign it immediately. Example:
# Define namespace unless it already exists
window.Test or= {}
# Create a class in the namespace and locally
window.Test.MyClass = class MyClass
constructor: (#a) ->
# Alerts 3
alert new Test.MyClass(1).a + new MyClass(2).a
As you see, now you can refer to it as MyClass within the file, but if you need it outside it's available as Test.MyClass. If you only want it in the Test namespace you can simplify it even more:
window.Test or= {}
# Create only in the namespace
class window.Test.MyClass
constructor: (#a) ->
Here's my personal implementation :
https://github.com/MaksJS/Namespace-in-CoffeeScript
How to use in the browser :
namespace Foo:SubPackage1:SubPackage2:
class Bar extends Baz
#[...]
How to use in CommonJS environment :
require './path/to/this/file' # once
namespace Foo:SubPackage1:SubPackage2:
class Bar extends Baz
#[...]
From the section about namespacing on the wiki: https://github.com/jashkenas/coffee-script/wiki/FAQ
# Code:
#
namespace = (target, name, block) ->
[target, name, block] = [(if typeof exports isnt 'undefined' then exports else window), arguments...] if arguments.length < 3
top = target
target = target[item] or= {} for item in name.split '.'
block target, top
# Usage:
#
namespace 'Hello.World', (exports) ->
# `exports` is where you attach namespace members
exports.hi = -> console.log 'Hi World!'
namespace 'Say.Hello', (exports, top) ->
# `top` is a reference to the main namespace
exports.fn = -> top.Hello.World.hi()
Say.Hello.fn() # prints 'Hi World!'
You must really check out CoffeeToaster:
https://github.com/serpentem/coffee-toaster
It comes with a packaging system that when enabled will use your folder's hierarchy as namespaces declarations to your classes if you want so, then you can extends classes from multiple files, do imports and son, such as like:
#<< another/package/myclass
class SomeClass extends another.package.MyClass
The build configuration is extremely minimalist and simple, made to be obvious:
# => SRC FOLDER
toast 'src_folder'
# => VENDORS (optional)
# vendors: ['vendors/x.js', 'vendors/y.js', ... ]
# => OPTIONS (optional, default values listed)
# bare: false
# packaging: true
# expose: ''
# minify: false
# => HTTPFOLDER (optional), RELEASE / DEBUG (required)
httpfolder: 'js'
release: 'www/js/app.js'
debug: 'www/js/app-debug.js'
There's also a debug option that compile files individually for ease the debugging processes and another useful features.
Hope it helps.
Note that it is possible to write:
class MyObject.MyClass
constructor: () ->
initializeStuff()
myfunction: () ->
doStuff()
if you declared an object/ns MyObject.
And while we're at it, here's my implementation of a jquery-ns-function:
(function($) {
$.namespace = function(namespace, initVal) {
var nsParts = namespace.split("."),
nsPart = nsParts.shift(),
parent = window[nsPart] = window[nsPart] || {},
myGlobal = parent;
while(nsPart = nsParts.shift()) {
parent = parent[nsPart] = parent[nsPart] || {};
}
return myGlobal;
}
})(jQuery);
I Strongly suggest using requirejs.org or similar battle tested module loaders.
Especially if you want to load stuff asynchronously.
Rolling your own namespacing/module scheme is really hard if you disregard
the simply, easy and naive approaches
As I'm also busy to learn the best way of structuring the files and use coffeescript in combination with backbone and cake, I have created a small project on github to keep it as a reference for myself, maybe it will help you too around cake and some basic things. All .js (with cake compiled files) are in www folder so that you can open them in your browser and all source files (except for cake configuration) are in src folder. In this example, all .coffee files are compiled and combined in one output .js file which is then included in html.
Based on some of the answers here on StackOverflow I have created small util.coffee file (in src folder) that exposes "namespaces" to the rest of the code.

Mocking super class calls in Perl (using Test::MockObject)

I'm using MockObjects in some of my tests and just had to test a function with a call to a SUPER class and I cannot seem to make it work. Can UNIVERSAL calls like $this->SUPER::save() not be mocked? If yes, how do you do it?
Thanks.
Edit:
Found it!
Use fake_module from Test::MockObject
So, let's say your base module it Some::Module, and your subroutine is making a $this->SUPER::save call, use
my $child_class_mockup = Test::MockObject->new();
$child_class_mockup->fake_module(
'Some::Module',
save => sub () { return 1; }
);
Leaving the question open for a couple of days, to get inputs about different ways/libraries of doing this (what if, the SUPER call had a SUPER call?) before accepting this answer.
Find out the name of the object's superclass (or one of the superclasses, since Perl has multiple inheritance), and define the save call in the superclass's package.
For example, if you have
package MyClass;
use YourClass;
our #ISA = qw(YourClass); # <-- name of superclass
...
sub foo {
my $self = shift;
...
$self->SUPER::save(); # <--- want to mock this function in the test
...
}
sub save {
# MyClass version of save method
...
}
then in your test script, you would say
no warnings 'redefine'; # optional, suppresses warning
sub YourClass::save {
# mock function for $yourClassObj->save, but also
# a mock function for $myClassObj->SUPER::save
...
}

Problems with Test::Class startup / setup inheritance

G'day,
I was using Test::Class perl module for some testing recently and ran into a strange problem. Basically, I have a base class inheriting from Test::Class
package Base::Class;
use base qw(Test::Class);
setup : Test(startup) {
# Create a DB from scratch
}
teardown : Test(shutdown) {
# DROP database
}
And then I have a whole bunch of test classes inheriting this base class,
package Some::Class;
use base qw(Base::Class);
sub actually_relevant_tests { }
But when I run my test script:
use Some::Class;
Test::Class->runtests;
The DB is created and dropped TWICE? Once for the base class and once for the sub-class! How do you avoid this without the solution being an ugly hack?
Thanks.
Edit: The closest thing to elegance I have right now is -
use Test::Class;
my $object = Some::Class->new();
Test::Class->runtests($object);
package Some::Class;
use Base::Class;
sub actually_relevant_tests { }
But keeping question open for better solutions.
In your base class use:
sub SKIP_CLASS { shift eq __PACKAGE__ }
This ignores the Base::Class during runtests as an acutal Test::Class and accordingly startup/shutdown methods will only be called for Some::Class.
Can you eliminate a layer of the inheritance hierarchy? Why not delegate setup and teardown to helper functions?
package My::DB::Helpers;
sub setup_db {...}
sub teardown_db {...}
and then
package Some::Class;
use My::DB::Helpers;
use base 'Test::Class';
setup : Test(startup) {
My::DB::Helpers::setup_db;
}
teardown : Test(shutdown) {
My::DB::Helpers::teardown_db;
}

In Perl, what is the right way for a subclass to alias a method in the base class?

I simply hate how CGI::Application's accessor for the CGI object is called query.
I would like my instance classes to be able to use an accessor named cgi to get the CGI object associated with the current instance of my CGI::Application subclass.
Here is a self-contained example of what I am doing:
package My::Hello;
sub hello {
my $self =shift;
print "Hello #_\n";
}
package My::Merhaba;
use base 'My::Hello';
sub merhaba {
goto sub { shift->hello(#_) };
}
package main;
My::Merhaba->merhaba('StackOverflow');
This is working as I think it should and I cannot see any problems (say, if I wanted to inherit from My::Merhaba: Subclasses need not know anything about merhaba).
Would it have been better/more correct to write
sub merhaba {
my $self = shift;
return $self->hello(#_);
}
What are the advantages/disadvantages of using goto &NAME for the purpose of aliasing a method name? Is there a better way?
Note: If you have an urge to respond with goto is evil don't do it because this use of Perl's goto is different than what you have in mind.
Your approach with goto is the right one, because it will ensure that caller / wantarray and the like keep working properly.
I would setup the new method like this:
sub merhaba {
if (my $method = eval {$_[0]->can('hello')}) {
goto &$method
} else {
# error code here
}
}
Or if you don't want to use inheritance, you can add the new method to the existing package from your calling code:
*My::Hello::merhaba = \&My::Hello::hello;
# or you can use = My::Hello->can('hello');
then you can call:
My::Hello->merhaba('StackOverflow');
and get the desired result.
Either way would work, the inheritance route is more maintainable, but adding the method to the existing package would result in faster method calls.
Edit:
As pointed out in the comments, there are a few cases were the glob assignment will run afoul with inheritance, so if in doubt, use the first method (creating a new method in a sub package).
Michael Carman suggested combining both techniques into a self redefining function:
sub merhaba {
if (my $method = eval { $_[0]->can('hello') }) {
no warnings 'redefine';
*merhaba = $method;
goto &merhaba;
}
die "Can't make 'merhaba' an alias for 'hello'";
}
You can alias the subroutines by manipulating the symbol table:
*My::Merhaba::merhaba = \&My::Hello::hello;
Some examples can be found here.
I'm not sure what the right way is, but Adam Kennedy uses your second method (i.e. without goto) in Method::Alias (click here to go directly to the source code).
This is sort of a combination of Quick-n-Dirty with a modicum of indirection using UNIVERSAL::can.
package My::Merhaba;
use base 'My::Hello';
# ...
*merhaba = __PACKAGE__->can( 'hello' );
And you'll have a sub called "merhaba" in this package that aliases My::Hello::hello. You are simply saying that whatever this package would otherwise do under the name hello it can do under the name merhaba.
However, this is insufficient in the possibility that some code decorator might change the sub that *My::Hello::hello{CODE} points to. In that case, Method::Alias might be the appropriate way to specify a method, as molecules suggests.
However, if it is a rather well-controlled library where you control both the parent and child categories, then the method above is slimmmer.

Detecting Overridden Methods in Perl

Last week I was bitten twice by accidentally overriding methods in a subclass. While I am not a fan of inheritance, we (ab)use this in our application at work. What I would like to do is provide some declarative syntax for stating that a method is overriding a parent method. Something like this:
use Attribute::Override;
use parent 'Some::Class';
sub foo : override { ... } # fails if it doesn't override
sub bar { ... } # fails if it does override
There are a couple of issues here. First, if method loading is delayed somehow (for example, methods loaded via AUTOLOAD or otherwise later installed in the symbol table), this won't detect those methods.
Walking the inheritance tree could also get similarly expensive. I do this with Class::Sniff, but it's not really suitable for running code. I could walk the inheritance tree and simply match where there's a defined CODE slot in the appropriate symbol table and that would be faster, but if the method cache is invalidated, that would break if I were to cache those results.
So I have two questions: is this a reasonable approach and is there a hook which allows me to check if the method cache has changed? (search for 'cache' in 'perldoc perlobj').
Of course, this shouldn't break production code, I am thinking about only having it fail or warn if the TEST_HARNESS environment variable is active (and have an explicit environment variable to force it to be inactive, if production code were to set the TEST_HARNESS environment variable for some reason).
One way to enforce this:
package Base;
...
sub new {
my $class = shift;
...
check_overrides( $class );
...
}
sub check_overrides {
my $class = shift;
for my $method ( #unoverridable ) {
die "horribly" if __PACKAGE__->can( $method ) != $class->can( $method );
}
}
Memoization of check_overrides may be helpful.
If there are some cases where you want exemptions, have an alternate method name and
have the base class call that:
package Base;
...
my #unoverridable = 'DESTROY';
sub destroy {}
sub DESTROY {
my $self = shift;
# do essential stuff
...
$self->destroy();
}