How to initialize a session in Catalyst application? - perl

here is the myapp's module from the lib folder:
package myapp;
use Moose;
use namespace::autoclean;
use Catalyst::Runtime 5.80;
use Catalyst qw/
ConfigLoader
Session
Session::Store
Session::State
Static::Simple
/;
extends 'Catalyst';
our $VERSION = '0.01';
__PACKAGE__->config(
name => 'myapp',
# Disable deprecated behavior needed by old applications
disable_component_resolution_regex_fallback => 1,
enable_catalyst_header => 1, # Send X-Catalyst header
);
sub init {
my ( $c ) = #_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
$c->session->{ed_year} = $year + 1900;
}
# Start the application
__PACKAGE__->setup();
__PACKAGE__->init();
1;
The example above is wrong, there is no available context($c). I would like to know if it is possible to initialize a session in a Catalyst application right in its main module. Here I would like to initialize global variables, used later by views, models and controllers?
Best regards,
SK

A session is associated with a user, and is an artifact of interaction with that user. You can't create a session in the main program - as you rightly say, there's no context at that point. In any case, what I think you're wanting to do is to configure some variables that will be available to any user of the application, so they're global, not user-specific anyway.
Use __PACKAGE__->config - it's just a hashref, and that's what it's for. You're certainly not limited to the documented keys.
For example:
__PACKAGE__->config(
name => 'myapp',
# Disable deprecated behavior needed by old applications
disable_component_resolution_regex_fallback => 1,
enable_catalyst_header => 1, # Send X-Catalyst header
ed_year => (localtime())[5] + 1900,
foo => { bar => 1, baz => 'quux' },
);
In your models, views and controllers those values will be available as $c->config->{ed_year} and $c->config->{foo}->{baz} and so on.
By the way, perhaps your use of ed_year was just a simplistic example, but consider how that will be instantiated: it will be the date and time the server is started, not the time of the current request. If the latter is what you want, put it in the auto handler of your Root.pm controller. And don't roll your own with localtime, use the DateTime module.

Related

Perl share variables with subclasses

I know this may be a very simple topic but I am trying to get the best logic since I am still new to Perl.
If I do not use OO and just split the code into files, all global variables are accessed among all files.
I am trying to do the same but using OO style. Example is I want a base class say called "BaseSub" that has a hash containing the configuration for the application say called %Config. Now I have a sub class called "DB" for the database connection and I want to access the settings from %Config which lives in "BaseSub" package. How do I do that.
If you're writing OO perl in this day and age, you really should be using Moose. It makes OO code much easier, cleaner and smaller.
The proper way to inherit variables is to make object attributes. Here's a quick example:
package MyBaseClass;
use Moose;
has config => (
is => 'ro',
default => sub { {
who => 'World',
} }
);
package MyClass;
use Moose;
extends qw(MyBaseClass);
sub greet
{
my $self = shift;
printf("Hello %s!\n", $self->config->{who});
}
package main;
my $object = MyClass->new();
$object->greet();
A great starting point for learning about Moose is the Moose::Manual.
Edit:
If you want be able to modify the config, you can either just poke the hashref returned from the config accessor directly:
$object->config->{who} = 'Friends';
But a better approach might be to make a config class and make the config attribute hold an instance of that:
package Myconfig;
use Moose;
has who => (is => 'rw', default => 'World');
package MyBaseClass;
use Moose;
has config => (
is => 'ro',
isa => 'MyConfig',
default => sub { MyConfig->new },
);
# inherit, instantiate, etc as before...
$object->config->who('Friends');
Another approach could be Moose::Meta::Attribute::Native::Trait::Hash which makes it easy to setup helper methods to work with native Perl datatypes.
Use its full name.
for (keys(%BaseSub::Config)) {
print("$_: $BaseSub::Config{$_}\n");
}
You could also import it.
our %Config; *Config = \%BaseSub::Config;
for (keys(%Config)) {
print("$_: $Config{$_}\n");
}

Moose attributes: separating data and behaviour

I have a class built with Moose that's essentially a data container for an article list. All the attributes - like name, number, price, quantity - are data. "Well, what else?", I can hear you say. So what else?
An evil conspiration of unfortunate circumstances now forces external functionality into that package: Tax calculation of the data in this class has to be performed by an external component. This external component is tightly coupled to an entire application including database and dependencies that ruin the component's testability, dragging it into the everything-coupled-together stew. (Even thinking about refactoring the tax component out of the stew is completely out of the question.)
So my idea is to have the class accept a coderef wrapping the tax calculation component. The class would then remain independent of the tax calculation implementation (and its possible nightmare of dependencies), and at the same time it would allow integration with the application environment.
has 'tax_calculator', is => 'ro', isa => 'CodeRef';
But then, I'd have added a non-data component to my class. Why is that a problem? Because I'm (ab)using $self->meta->get_attribute_list to assemble a data export for my class:
my %data; # need a plain hash, no objects
my #attrs = $self->meta->get_attribute_list;
$data{ $_ } = $self->$_ for #attrs;
return %data;
Now the coderef is part of the attribute list. I could filter it out, of course. But I'm unsure any of what I'm doing here is a sound way to proceed. So how would you handle this problem, perceived as the need to separate data attributes and behaviour attributes?
A possible half thought out solution: use inheritance. Create your class as you do today but with a calculate_tax method that dies if called (i.e. a virtual function). Then create subclass that overrides that method to call into the external system. You can test the base class and use the child class.
Alternate solution: use a role to add the calculate_tax method. You can create two roles: Calculate::Simple::Tax and Calculate::Real::Tax. When testing you add the simple role, in production you add the real role.
I whipped up this example, but I don't use Moose, so I may be crazy with respect to how to apply the role to the class. There may be some more Moosey way of doing this:
#!/usr/bin/perl
use warnings;
{
package Simple::Tax;
use Moose::Role;
requires 'price';
sub calculate_tax {
my $self = shift;
return int($self->price * 0.05);
}
}
{
package A;
use Moose;
use Moose::Util qw( apply_all_roles );
has price => ( is => "rw", isa => 'Int' ); #price in pennies
sub new_with_simple_tax {
my $class = shift;
my $obj = $class->new(#_);
apply_all_roles( $obj, "Simple::Tax" );
}
}
my $o = A->new_with_simple_tax(price => 100);
print $o->calculate_tax, " cents\n";
It appears as if the right way to do it in Moose is to use two roles. The first is applied to the class and contains the production code. The second is applied to an object you want to use in testing. It subverts the first method using an around method and never calls the original method:
#!/usr/bin/perl
use warnings;
{
package Complex::Tax;
use Moose::Role;
requires 'price';
sub calculate_tax {
my $self = shift;
print "complex was called\n";
#pretend this is more complex
return int($self->price * 0.15);
}
}
{
package Simple::Tax;
use Moose::Role;
requires 'price';
around calculate_tax => sub {
my ($orig_method, $self) = #_;
return int($self->price * 0.05);
}
}
{
package A;
use Moose;
has price => ( is => "rw", isa => 'Int' ); #price in pennies
with "Complex::Tax";
}
my $prod = A->new(price => 100);
print $prod->calculate_tax, " cents\n";
use Moose::Util qw/ apply_all_roles /;
my $test = A->new(price => 100);
apply_all_roles($test, 'Simple::Tax');
print $test->calculate_tax, " cents\n";
A couple of things come to mind:
Implement the tax calculation logic in a separate TaxCalculation class that has the article list and the tax calculator as attributes.
Use a mock object as the tax calculator when you test. The tax calculator could be stored in an attribute that by default creates the real tax calculator. The test passes in a mock object that has the same interface but doesn't do anything.
Actually that's not really an abuse of get_attribute_list since that's rather exactly how MooseX::Storage works[^1]. IF you are going to continue to use get_attribute_list to build your straight data you'll want to do what MooseX::Storage does and set up an attribute trait for "DoNotSerialize"[^2]:
package MyApp::Meta::Attribute::Trait::DoNotSerialize;
use Moose::Role;
# register this alias ...
package Moose::Meta::Attribute::Custom::Trait::DoNotSerialize;
sub register_implementation { 'MyApp::Meta::Attribute::Trait::DoNotSerialize' }
1;
__END__
You then can use this in your class like so:
has 'tax_calculator' => ( is => 'ro', isa => 'CodeRef', traits => ['DoNotSerialize'] );
and in your serialization code like so:
my %data; # need a plain hash, no objects
my #attrs = grep { !$_->does('MyApp::Meta::Attribute::Trait::DoNotSerialize') } $self->meta->get_all_attributes; # note the change from get_attribute_list
$data{ $_ } = $_->get_value($self) for #attrs; # note the inversion here too
return %data;
Ultimately though you will end up in a solution similar to the Role one that Chas proposes, and I just answered his follow up question regarding it here: How to handle mocking roles in Moose?.
Hope this helps.
[^1]: And since the most basic use-case for MooseX::Storage is doing exactly what you describe, I highly suggest looking at it to do what you're doing by hand here.
[^2]: Or simply re-use the one from MooseX::Storage creates.

How do you dynamically include a module based on what modules are available?

I have a perl script that uses the CGI::Session::Drive::memcached, but I want to be able to fallback on the default Session driver or another driver if it's available on the system...
This is how I started off using Memcache, but this doesnt necessarily solve the problem of the case when Cache::Memecached and/or CGI::Session::Driver::memcached are not available...
package MySession;
use Moose::Role;
use Moose::Util::TypeConstraints;
use namespace::autoclean;
use CGI::Session ('-ip_match');
use CGI::Session::Driver::memcached;
use Cache::Memcached::Fast;
#would be nice to create this conditionally, or use a delegate maybe
has 'memeCached' => (
is => 'rw',
isa => 'Maybe[Cache::Memcached::Fast]',
default => sub{ return Cache::Memcached::Fast->new( {'servers' => [ '10.x.x.x.:10001' ],'compress_threshold' => '100000','nowait' => 1,'utf8' => 1} ) },
);
sub buildSession{
my($this,$cgi,$sessionDir) = #_;
$cgi = $cgi || $this->getCGI();
my $sid = $this->SID();
my $mem = $this->memeCached();
my $sss;
if(!$mem){
$sss = CGI::Session->load(undef, $cgi, {Directory=>$sessionDir}) or die CGI::Session->errstr();
}else{
$sss = CGI::Session->load( "driver:memcached", $cgi, { Memcached => $mem }) or die CGI::Session->errstr();
}
...
Then this got me thinking, how do I do this -- in a general sense? or what's the best way to do this (especially using Moose)?
I had a similar situation. We use Windows domains, which I can connect to Net::LDAP. In my program, I want to be able to take the user ID jsmith, and instead of printing on the user ID, I want to be able to print out the name John Smith.
Many people at my company use my program, but not all are Perl experts and most wouldn't know how to install a Perl module. And, since Net::LDAP is not a standard module, many people don't have it.
Instead, I wanted a fallback routine. If I could look up the name with Net::LDAP, I would print the name, if I couldn't load Net::LDAP, I would fallback and just print the user ID.
I used the following for testing if Net::LDAP was installed, and load it if possible:
BEGIN {
eval { require Net::LDAP; };
our $Net_Ldap_Status = 1 if (not $#);
}
What you have to understand is that:
use Foo::Bar;
is the same as:
BEGIN {
require Foo::Bar;
}
It loads in the module at compile time. By surrounding the require with an eval I can test whether the statement succeeds (and the module is loaded) or fails (the module doesn't load, but the program doesn't crash either.) I can then check $# to see if the module loaded or not. $# is the error message that eval sets. If $# is null, then the module exists and was loaded successfully.
I need to use a package variable (the our $Net_Ldap_Status instead of my $Net_Ldap_Status) or the variable will be lost when the program runs. (I'm not even sure if my $Net_Ldap_Status would work in a BEGIN statement).
Now, here's where things get funky...
When I need to check $Net_Ldap_Status, I need to redeclare it:
our $Net_Ldap_Status;
or I tend to get that non-declared variable error. The funny thing is that it doesn't lose its previous value by redeclaring it. Thus, somewhere in my code is:
our $Net_Ldap_Status;
if ($Net_Ldap_Status) {
print "Code if Net::LDAP is loaded.\n";
}
else {
print "Fallback Code if no Net::LDAP\n";
}

Setting Up Perl Module Structure

I'm having trouble figuring out how to structure Perl modules in an object oriented way so I can have one parent module with a number of submodules and only the specific submodules that are needed would be loaded by a calling script. For example I want to be able to make method calls like so:
use Example::API;
my $api = Example::API->new();
my $user = {};
$user->{'id'} = '12345';
$api->Authenticate();
$user->{'info'} = $api->Users->Get($user->{'id'});
$user->{'friends'} = $api->Friends->Get($user->{'id'});
In terms of file structure I'd like to have the modules setup as follows or in whatever structure is required to make everything work correctly:
api.pm
users.pm
friends.pm
...
The reason I want to do this in the first place is so that if someone just wants to authenticate against the API they don't have to load all the other modules. Similarly, if someone just wants to get a user's information, they wouldn't have to load the friends.pm module, just the users.pm. I'd appreciate it if you could provide the necessary example Perl code for setting up each module as well as explain how the file structure should be setup. If I'm going about this all wrong to accomplish what I'm try to accomplish I'd appreciate an explanation of the best way to do this and some example code on how it should be setup.
From your example, in your main module I assume you will be providing accessor methods to get at the subclasses. So all you have to do is include require Sub::Module; at the top of that method. Nothing will happen at compile time, but the first time that code is run, perl will load the module. After the first load, the line require Sub::Module; will become a no-op.
If all of your code is object oriented, you won't need to worry about importing functions. But if you do, the statement use Module qw(a b c); is interpreted as:
BEGIN {
require Module;
Module->import(qw(a b c));
}
BEGIN makes it happen at compile time, but there is nothing stopping you from using the internals at run time. Any subroutines you import at runtime must be called with parenthesis, and prototypes will not work, so unless you know what you are doing, runtime imports are probably a bad idea. Runtime requires and access via package methods are completely safe though.
So your $api->Users method might work something like this:
# in package 'Example::API' in the file 'Example/API.pm'
sub Users {
require Example::API::Users; # loads the file 'Example/API/Users.pm'
return Example::API::Users->new( #_ ); # or any other arguments
}
In my examples above, I showed two translations between package names and the files they were in. In general, all :: are changed to / and .pm is added to the end. Then perl will search for that file in all of the directories in the global variable #INC. You can look at the documentation for require for all of the details.
Update:
One way to cache this method would be to replace it at runtime with a function that simply returns the value:
sub Users {
require Example::API::Users;
my $users = Example::API::Users->new;
no warnings 'redefine';
*Users = sub {$users};
$users
}
Here's a big ugly Moose example that selectively applies roles to an API driver instance.
script.pl
use Example::User;
# User object creates and authenticates a default API object.
my $user = Example::User->new( id => '12345' );
# When user metadata is accessed, we automatically
# * Load the API driver code.
# * Get the data and make it available.
print "User phone number is: ", $user->phone_number, "\n";
# Same thing with Friends.
print "User has ", $user->count_friends, " friends\n";
print "User never logged in\n" unless $user->has_logged_in;
Example/API.pm - the basic protocol driver class:
package Example::API;
use Moose;
has 'host' => (
is => 'ro',
default => '127.0.0.1',
);
sub Authenticate {
return 1;
}
# Load the user metadata API driver if needed.
# Load user metadata
sub GetUserInfo {
my $self = shift;
require Example::API::Role::UserInfo;
Example::API::Role::UserInfo->meta->apply($self)
unless $self->does('Example::API::Role::UserInfo');
$self->_Get_UserInfo(#_);
}
# Load the friends API driver if needed.
# Load friends data and return an array ref of Friend objects
sub GetFriends {
my $self = shift;
#require Example::API::Role::Friends;
Example::API::Role::Friends->meta->apply($self)
unless $self->does('Example::API::Role::Friends');
$self->_Get_Friends(#_);
}
The user metadata and friends data drivers are built as 'roles' which are dynamically applied to an API driver instance as needed.
Example/API/Role/UserInfo.pm:
package Example::API::Role::UserInfo;
use Moose::Role;
sub _Get_UserInfo {
my $self = shift;
my $id = shift;
my $ui = Example::API::User::MetaData->new(
name => 'Joe-' . int rand 100,
phone_number => int rand 999999,
);
return $ui;
}
Example/API/Role/Friends.pm:
use Moose::Role;
sub _Get_Friends {
my $self = shift;
my $id = shift;
my #friends = map {
Example::API::Friend->new(
friend_id => "$id-$_",
name => 'John Smith'
);
} 1 .. (1 + int rand(5));
return \#friends;
}
A friend object:
Example/API/Friend.pm
package Example::API::Friend;
use Moose;
has 'friend_id' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'name' => ( isa => 'Str', is => 'ro', required => 1 );
And a user metadata object.
Example/API/User/MetaData.pm
package Example::API::User::MetaData;
use Moose;
has 'name' => (
is => 'ro',
isa => 'Str',
);
has 'phone_number' => (
is => 'ro',
isa => 'Str',
);
has 'last_login' => (
is => 'ro',
isa => 'DateTime',
predicate => 'has_logged_in',
);
And finally a user object. I've used many Moose features to make this a very capable object with only a small amount of imperative code.
package Example::User;
use Moose;
has 'id' => (
is => 'ro',
isa => 'Int',
required => 1,
);
has 'server_connection' => (
is => 'ro',
isa => 'Example::API',
builder => '_build_server_connection',
);
# Work with a collection of friend objects.
has 'friends' => (
is => 'ro',
isa => 'ArrayRef[Example::API::Friend]',
traits => ['Array'],
handles => {
all_friends => 'elements',
map_friends => 'map',
filter_friends => 'grep',
find_option => 'first',
get_option => 'get',
join_friends => 'join',
count_friends => 'count',
has_no_friends => 'is_empty',
sorted_friends => 'sort',
},
lazy_build => 1,
);
has 'user_info' => (
is => 'ro',
isa => 'Example::API::User::MetaData',
handles => {
name => 'name',
last_login => 'last_login',
phone_number => 'phone_number',
has_logged_in => 'has_logged_in',
},
lazy_build => 1,
);
sub _build_server_connection {
my $api = Example::API->new();
$api->Authenticate();
return $api;
}
sub _build_friends {
my $self = shift;
$self->server_connection->GetFriends( $self->id );
}
sub _build_user_info {
my $self = shift;
$self->server_connection->GetUserInfo( $self->id );
}
This example makes use of a lot of Moose magic, but you wind up with a very simple interface for those using the objects. While this is close to 200 lines of formatted code, we get a huge amount done.
Adding type coercion would give an even easier interface. Raw string dates can be automatically parsed into DateTime objects. Raw IP addresses and server names can be converted into API servers.
I hope this inspires you to take a look at Moose. The documentation is excellect, check out the Manual and the Cookbooks, in particular.
Managing the exports is tricky, but you could use an AUTOLOAD solution to this problem. If perl doesn't recognize the subroutine name you are trying to call, it can pass it to a sub called AUTOLOAD. Suppose we did this:
use Example::API;
sub AUTOLOAD {
my $api = shift;
eval "require $AUTOLOAD"; # $api->Foo->... sets $AUTOLOAD to "Example::API::Foo"
die $# if $#; # fail if no Example::API::Foo package
$api;
}
Then this code:
$api = new Example::API;
$api->Foo->bar(#args);
will (assuming we haven't imported Example::API::Foo first) call our AUTOLOAD method, attempt to load the Example::API::Foo module, and then try to call the method Example::API::Foo::bar with the $api object and the other arguments you provide.
Or in the worst case,
$api->Foo->bar(#args)
causes this code to be invoked
eval "require Example::API::Foo";
die $# if $#;
&Example::API::Foo::bar($api,#args);
Depending on how you use this feature, it might be a lot more overhead than just importing everything you need.
There are a number of tools that can be used to quickly build an skeletal structure for your new module development.
h2xs comes with the standard Perl distribution. Its primary focus is on building XS code for interfacing with C libraries. However, it does provide basic support for laying out pure Perl projects: h2xs -AX --skip-exporter -n Example::API
I use Module::Starter to build a beginning layout for my module development. It does a lot that h2xs doesn't do. module-starter --module=Example::API,Example::Friends,Example::Users --author="Russel C" --email=russel#example.com
Dist::Zilla is a new tool that handles many tasks related to maintaining a Perl module distribution. It is amazingly powerful and flexible. But it is new and the docs are a bit rough. The unavoidable complexity that comes with all that power and flexibility means that learning to use it is a project. It looks very interesting, but I haven't taken the time to dive in, yet.
If you need to limit the number of methods loaded, you can use AutoLoader or SelfLoader to load subroutines as they are called. This will lead to a slight overhead when a method is called for the first time. In my experience, this approach is rarely needed.
The best thing is to keep your objects small and strictly defined so that they embody a simple concept. Do not allow ambiguity or half-way concepts into your objects, instead consider using composition and delegation to handle areas of potential confusion. For example, instead of adding date formatting methods to handle a user's last login, assign DateTime objects to the last_login attribute.
In the interest of making composition and delegation easy, consider using Moose to build your objects. It removes much of the drudgery involved in Perl OOP and object composition and delegation in specific.

Accessing the Catalyst object $c from MyApp.pm

I'm using the Assets plugin in my Catalyst app, and I would like some javascript and css files included in the assets of every page.
My first thought is call $c->assets->include('file.js') from MyApp/lib/MyApp.pm where I do setup and config, but I don't know how to get a hold of $c there.
My next idea involves using the WRAPPER stuff, and placing calls like [% c.assets.include('file.js') %] in default html template, but the calls dump the object information to the page, so the calls would have to be uglied up to suppress output.
Solutions or new ideas appreciated. Thanks in advance.
There is no context object yet during application setup, since the $c represents the current request.
If you are using Chained, you can do the call in your root chain action. If you use the non-Chained action types like Local, Path, etc. you can put a begin action in your root controller.
The most correct way in my opinion is however to extend the view. Here's some example code:
package MyApp::View::HTML;
use Moose;
use MooseX::Types::Moose qw( ArrayRef Str );
use namespace::autoclean;
extends 'Catalyst::View::TT';
has common_assets => (
traits => [qw( Array )],
isa => ArrayRef[Str],
handles => {
common_assets => 'elements',
},
);
before process => sub {
my ($self, $ctx) = #_;
$ctx->assets->include($_)
for $self->common_assets;
};
1;
Then you can configure it with something like this:
<view HTML>
common_assets foo.css
common_assets bar.js
</view>