I currently have the following at the beginning of several test files, but it's very not DRY. But I'm not really sure what the best way to move this into its own file is. Any suggestions?
#!/usr/bin/perl
use strict;
use warnings;
BEGIN {
use Test::More;
use namespace::clean qw( pass );
}
use FindBin;
use Cwd qw( realpath );
use Dancer qw( :syntax );
use Test::WWW::Mechanize::PSGI;
set apphandler => 'PSGI';
my $appdir = realpath( "$FindBin::Bin/.." );
my $t = Test::WWW::Mechanize::PSGI->new(
app => sub {
my $env = shift;
setting(
appname => 'MyApp',
appdir => $appdir,
);
load_app 'MyApp';
config->{environment} = 'test';
Dancer::Config->load;
my $request = Dancer::Request->new( env => $env );
Dancer->dance( $request );
}
);
$t->agent('test');
$t->get_ok('/login') or diag $t->content;
$t->submit_form_ok({
form_name =>'loginform',
fields => {
username => 'myuser',
password => 'foo',
},
}, 'login ok' );
### END BOILERPLATE ###
update
unfortunately part of my problem with moving this off into a library is that as soon as I've done that the code stops working. I tried encapsulating it into a subroutine and returning $t but that doesn't appear to work. I'm trying to figure out what exactly needs to go into the library and what exactly needs to go into the test.
Make it a module (say t::MyApp), change my $t to our $t, and have the module export $t. (You could also write a custom import method to turn on strict & warnings in your test script.)
You could create a .pm module that includes these lines, with some object-oriented code to obtain the $t and other information from the boilerplate code, and then use it from your tests.
Related
I am trying to serve a template contained in the __DATA__ section of a controller class, but it doesn't seem to work.
In my main app.pl file I have
#!/usr/bin/env perl
use Mojolicious::Lite -signatures;
use FindBin qw($Bin);
use lib "$Bin/lib";
push #{app->renderer->classes}, 'Zairyo::Controller::Data';
push #{app->preload_namespaces}, 'Zairyo::Controller::Data';
get '/:uid' => [uid => qr/[a-z0-9]{32,32}/i ] => { controller => 'Data', action => 'serve_iframe' };
app->start;
and in Zairyo::Controller::Data:
package Zairyo::Controller::Data;
use Mojo::Base 'Mojolicious::Controller', -signatures;
sub serve_iframe ($c) {
$c->render(template => 'foo');
}
__DATA___
## foo.html.ep
what is this
which I'd expect to work as per the documentation but instead throws an error Could not render a response... on the browser and Template "foo.html.ep" not found on the log.
I've solved this by doing
$c->render(inline => data_section(__PACKAGE__, 'foo.html.ep') );
but it seems a bit of a hack.
What am I doing wrong here?
First, there are a few things a bit off in your Data.pm:
There are three underscores after __DATA when there should be two and a newline
The module does not return a true value
Here's what I ended up with:
package Zairyo::Controller::Data;
use Mojo::Base 'Mojolicious::Controller', -signatures;
sub serve_iframe ($c) {
$c->render(template => 'foo' );
}
1;
__DATA__
## foo.html.ep
what is this
In the main script, I load the class before I call start. Note that the docs say:
Note that for templates to be detected, these classes need to have already been loaded and added before warmup is called
And, warmup is called immediately by start, and it's warmup that cares about preload_namespaces. You need to get there even sooner, so preload_namespaces does nothing for this particular problem. If you haven't already loaded the module, its __DATA__ templates will not be detected.
#!/usr/bin/env perl
use Mojolicious::Lite -signatures;
use FindBin qw($Bin);
use lib "$Bin/lib";
push #{app->renderer->classes}, map { Mojo::Loader::load_class($_); $_ } 'Zairyo::Controller::Data';
get '/:uid' => [uid => qr/[a-z0-9]{32,32}/i ] => {
namespace => 'Zairyo::Controller',
controller => 'Data',
action => 'serve_iframe'
};
app->start;
I'm not suggesting this particular code, but now I know why you weren't getting what you wanted.
Edited to clarify / reflect what I've been trying:
I'm using CatalystX::I18N::* in order to be able to internationalise my site. I have that working nicely, and my site text is coming from $c->maketext().
However, I've been trying to access these codes from my database model (in order to generate, e.g., success or failure messages when checking input before creating / updating) and am struggling.
According to the CatalystX::I18N docs, CatalystX::I18N::Maketext is a 'Helpful wrapper around Locale::Maketext. Can also be used outside of Catalyst'.
I have MyApp::Maketext setup as directed:
package MyApp::Maketext;
use strict;
use warnings;
use parent qw(CatalystX::I18N::Maketext);
1;
I have a little test script running, the setup for which is this:
#!/usr/bin/perl
use strict;
use warnings;
use FindBin qw( $Bin );
use lib "$Bin/../lib";
use TopTable::Maketext;
use Path::Class::Dir;
my $dir = Path::Class::Dir->new( "$Bin/..", "root", "locale" );
TopTable::Maketext->load_lexicon(
locales => ["en_GB"], # Required
directories => [$dir], # Required
gettext_style => 0, # Optional, Default 1
);
I am then trying two different ways to get a handle to the maketext() method:
my $lang = TopTable::Maketext->get_handle;
printf "%s\n", $lang->maketext( "menu.title.news" );
Gives the following result:
Can't call method "maketext" on an undefined value at bin\maketext-demo.pl line 23.
If I swap ->get_handle to ->new:
my $lang = TopTable::Maketext->new;
printf "%s\n", $lang->maketext( "menu.title.news" );
I get the following:
maketext doesn't know how to say:
menu.title.news
as needed at bin\maketext-demo.pl line 23.
I'm at a bit of a loss as to what to try next! Thank you so much in advance for any pointers anyone can give.
Chris
I have finally got my head around this - this is the code that eventually worked:
#!/usr/bin/perl
use strict;
use warnings;
use FindBin qw( $Bin );
use lib "$Bin/../lib";
use Data::Dumper::Concise;
use TopTable::Maketext;
use Config::ZOMG;
use Path::Class::Dir;
my $tt_config = Config::ZOMG->new( name => 'TopTable' );
my $config_hash = $tt_config->load;
my (#locales, %inhertiance, $config);
$config = $config_hash->{I18N}{locales};
foreach my $locale (keys %$config) {
push(#locales, $locale);
$inhertiance{$locale} = $config->{$locale}{inherits} if defined $con
+fig->{$locale}{inherits};
}
my $dir = Path::Class::Dir->new( "$Bin/..", "root", "locale" );
TopTable::Maketext->load_lexicon(
locales => \#locales,
directories => [$dir],
gettext_style => 1,
inheritance => \%inhertiance,
);
my $lang = TopTable::Maketext->get_handle( "en_GB" );
printf "%s\n", $lang->maketext( "menu.title.league-tables", "Division Three" );
1;
This gives the correct value of:
League Tables for Division Three
Thanks for putting up with my spam!
I have a script Attachments.pm which contains below
package app::Attachments;
use MIME::Lite;
BEGIN {
use Exporter();
#ISA = qw(Exporter);
#EXPORT = qw(&SendEMmsgAttachments);
}
sub SendEMmsgAttachments {
$EM_SERVER = "1234.com";
$EM_FROM = "yyy#1234.com"; #hardcoded
$EM_TIMEOUT = 120;
my $mailMessage;
my $mailToEmailAddress;
my $mailSubject;
my $mailBody;
my $mailAttachmentFileName;
my $mailAttachmentFullPath;
$mailMessage = MIME::Lite->new(
From => $EM_FROM,
To => $mailToEmailAddress,
Subject => $mailSubject,
Type => 'multipart/mixed'
) or die "Error creating multipart container: $!\n";
### Add the text message part
$mailMessage->attach(
Type => 'text/csv',
Data => $mailBody
) or die "Error adding the text message part: $!\n";
### Add the text file
$mailMessage->attach(
Encoding => 'base64',
Type => "text",
I want to use SendEMmsgAttachments in my testscript.pl file so that I can send my Excel attachment in email.
Can anyone help me out in resolving the issue?
Here is a very basic hello world, using a perl module and script, demonstrating how to use the Exporter library. See perldoc Exporter for more details.
Foo.pm
package Foo;
use strict;
use warnings FATAL => 'all';
use Exporter 'import';
our $VERSION = '0.01';
our #EXPORT_OK = qw( bar );
sub bar {
return "Hello World";
}
1; # Last statement of a .pm file must evaluate to 'true'
try_foo.pl
#!/usr/bin/env perl
use warnings;
use strict;
use Foo qw( bar );
my $msg = bar();
print $msg . "\n";
In action:
perl try_foo.pl
Hello World
In your program you have this line:
use Exporter();
This instructs Perl to load the Exporter module but to not import anything from it. The parentheses denote that you want to supply your own import list rather than accepting the default list. Since you have nothing in your import list, nothing is imported.
You get around this by inheriting from Exporter by adding it to #ISA. There's plenty of sample code out there that does this. However, you only really want the import routine rather than being a more specific version of an exporting tool. You can do that by asking for only the import routine:
use Exporter qw(import);
After that you need to specify what you want to export by default in #EXPORT. For subroutines, leave off the &. It's not a big deal but it's common to see it like this:
our #EXPORT = qw( SendEmmsgAttachments );
If you want your program to specifically ask to import a subroutine you can put that in #EXPORT_OK. These entries are not exported by default—they are allowed to be exported if you ask for them:
our #EXPORT_OK = qw( SendEmmsgAttachments );
The our is there to declare the variable as a package variable. Your program isn't bothered by that because you don't use strict (which isn't the end of the world but is a good habit).
I'd take your BEGIN block and replace it with:
use Exporter qw(import);
our #EXPORT_OK = qw( SendEmmsgAttachments );
When you run into problems like this, create the smallest example that shows the problem so you eliminate anything else that might be a problem.
This is a followup question to warnings::warnif( 'deprecated' … ) with carp?.
here's a snippet of my code from Business::CyberSource on Github
note: the previous answer (in the previous question), and adding of #CARP_NOT have demonstrated that warnings::warnif uses carp. I attempted to substitute carp directly, the behavior was exactly the same.
our #CARP_NOT = ( __PACKAGE__, qw( Class::MOP::Method::Wrapped ) );
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $args = $class->$orig( #_ );
if ( exists $args->{username} ) {
warnings::warnif('deprecated',
'`username` is deprecated, use `user` instead'
);
But when I call this code
use strict;
use warnings;
use Test::More;
use Business::CyberSource::Client;
my $class = 'Business::CyberSource::Client';
my $client
= new_ok( $class => [{
username => $ENV{PERL_BUSINESS_CYBERSOURCE_USERNAME} || 'test',
password => $ENV{PERL_BUSINESS_CYBERSOURCE_PASSWORD} || 'test',
production => 0,
}]);
The error is still reported from the wrong place (though at least not from Class::MOP::Method::Wrapped)
t/new-client.t .. `username` is deprecated, use `user` instead at constructor Business::CyberSource::Client::new (defined at /home/xenoterracide/Documents/Business-CyberSource/lib/Business/CyberSource/Client.pm line 314) line 6.
How can I make this report from the correct line number in the test file? (note: behavior did not change if I called ->new directly instead of using new_ok
I'm not sure on the right way to set up the script app for www mechanize. I did try at least one alternate that works, however I'm trying to pass in configuration with the test so I can make logging quieter with the test suite.
#!/usr/bin/perl
use strict;
use warnings;
use Dancer qw(:syntax);
use MyApp;
use Test::More;
use Test::WWW::Mechanize::PSGI;
set apphandler => 'PSGI';
set log => 'warning';
set logger => 'note';
my $mech = Test::WWW::Mechanize::PSGI->new(
app => dance, # app => do('bin/app.pl'), #
);
$mech->get_ok('/login') or diag $mech->content;
done_testing;
running do on the script seems to allow the test to run, but logging variables aren't set right and at the same time seems like there'd be a better way to do that.
update
I think I might be getting closer to a solution...
#!/usr/bin/perl
use strict;
use warnings;
use FindBin;
use Cwd qw( realpath );
use Dancer qw(:syntax);
use MyApp;
use Test::More;
use Test::WWW::Mechanize::PSGI;
set apphandler => 'PSGI';
my $appdir = realpath( "$FindBin::Bin/.." );
my $mech = Test::WWW::Mechanize::PSGI->new(
app => sub {
my $env = shift;
setting(
appname => 'MyApp',
appdir => $appdir,
);
load_app 'MyApp';
config->{environment} = 'test'; # setting test env specific in test.yml detected ok
Dancer::Config->load;
my $request = Dancer::Request->new( env => $env );
Dancer->dance( $request );
}
);
$mech->get_ok('/login') or diag $mech->content;
done_testing;
I took this from the Dancer::Deployment documentation for Plack PSGI. However, I'm getting a 500 error from the test.
t/001-login.t .. Subroutine main::pass redefined at t/001-login.t line 8
Prototype mismatch: sub main::pass: none vs (;$) at t/001-login.t line 8
Use of uninitialized value $_[0] in join or string at /home/ccushing/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/i686-linux/File/Spec/Unix.pm line 86.
# [2462] debug #0.004442> [hit #1]Adding mysql_enable_utf8 to DBI connection params to enable UTF-8 support in /home/ccushing/perl5/perlbrew/perls/perl- 5.14.1/lib/site_perl/5.14.1/Dancer/Plugin/Database.pm l. 148
# [2462] debug #0.117566> [hit #1]Adding mysql_enable_utf8 to DBI connection params to enable UTF-8 support in /home/ccushing/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Dancer/Plugin/Database.pm l. 148
# [2462] error #0.148703> [hit #1]request to /login crashed: '/login/default.tt' doesn't exist or not a regular file at /home/ccushing/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Dancer.pm line 161 in /home/ccushing/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Dancer/Handler.pm l. 84
# <h2>runtime error</h2><pre class="error">'/login/default.tt' doesn't exist or not a regular file at /home/ccushing/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Dancer.pm line 161
The DBI errors aren't relevant here, but their part of the error output I get. I can't figure out why it can't find /login/default.tt. I'm guessing that it's problem is that it has no idea where my views folder is as the template in question is at views/login/default.tt. This view works fine in the browser even when running on plackup. I'm stumped.
This works under the circumstance that I symlink t/views to views I currently believe this is probably the result of a bug, so I filed one here, and created this test case repository.
#!/usr/bin/perl
use strict;
use warnings;
BEGIN {
use Test::More;
use namespace::clean qw( pass );
}
use FindBin;
use Cwd qw( realpath );
use Dancer qw( :syntax );
#use MyApp;
use Test::WWW::Mechanize::PSGI;
set apphandler => 'PSGI';
my $appdir = realpath( "$FindBin::Bin/.." );
my $mech = Test::WWW::Mechanize::PSGI->new(
app => sub {
my $env = shift;
setting(
appname => 'MyApp',
appdir => $appdir,
);
load_app 'MyApp';
config->{environment} = 'test';
Dancer::Config->load;
my $request = Dancer::Request->new( env => $env );
Dancer->dance( $request );
}
);
$mech->get_ok('/') or diag $mech->content;
done_testing;
I set the logger and log in environments/test.yml.
I still get these errors, and I'd like to see them fixed but not sure what causes them.
Use of uninitialized value $_[0] in join or string at /home/ccushing/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/i686-linux/File/Spec/Unix.pm line 86.
Use of uninitialized value $path in -e at /home/ccushing/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Dancer/FileUtils.pm line 46.
Use of uninitialized value in index at /home/ccushing/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Dancer/Renderer.pm line 160.
Hopefully someone can provide me with a better answer than I've been able to hammer through.