I'm using Dancer2 and the YAML session engine. I stored a complete hash in a session with the following code:
post '/login' => sub {
# ...
my $userdata = {
fname => 'John',
lname => 'Doe',
uid => 1234,
};
# ...
session userdata => $userdata;
# ...
}
The omitted code checks the login data against a database and returns that $userdata hashref.
This code creates a session file under $appdir/sessions with this content:
session file
userdata:
fname: John
lname: Doe
uid: 1234
How can I retrieve single values from this session in my app.pm file?
It works great in the template files (*.tt) and <% session.userdata.fname %> yields John, as expected.
However, I want to fetch the first name in app.pm, like so:
get '/userdetails' => sub {
my $firstname = session('userdata.fname'); # gives undef
# do sth. with $firstname
}
Is that feasable? Or do I have to
my $userdata = session('userdata'); # fetch complete hash
# do sth. with $userdata->{fname}
I tried
session('userdata.fname')
session('userdata/fname')
session('userdata:fname')
session('userdata fname')
RTFM (YAML's and Dancer2's)
but none of them worked and gave undef. The manuals and tutorials only fetch "first level values", not nested ones.
The Template Toolkit syntax is completely independent of Perl Dancer2, and you should expect any form of addressing to carry over. The origin of the data as a YAML file is also irrelevant, as the Dancer session is just a Perl hash structure
The manual doesn't make it very clear, but
session('userdata')
is the same as
session->{userdata}
So you can use
session->{userdata}{fname}
to read the subsidiary fields
(Or possibly session('username')->{fname} if you prefer, but that looks a bit icky to me!)
Note that you shouldn't use the YAML session engine in production code, as it's very slow
Related
I have a perl code like this:
use constant OPERATING_MODE_MAIN_ADMIN => 'super_admin';
use constant OPERATING_MODE_ADMIN => 'admin';
use constant OPERATING_MODE_USER => 'user';
sub system_details
{
return {
operating_modes => {
values => [OPERATING_MODE_MAIN_ADMIN, OPERATING_MODE_ADMIN, OPERATING_MODE_USER],
help => {
'super_admin' => 'The system displays the settings for super admin',
'admin' => 'The system displays settings for normal admin',
'user' => 'No settings are displayed. Only user level pages.'
}
},
log_level => {
values => [qw(FATAL ERROR WARN INFO DEBUG TRACE)],
help => "http://search.cpan.org/~mschilli/Log-Log4perl-1.49/lib/Log/Log4perl.pm#Log_Levels"
},
};
}
How will I access the "value" fields and "help" fields of each key from another subroutine? Suppose I want the values of operating_mode alone or log_level alone?
The system_details() returns a hashref, which has two keys with values being hashrefs. So you can dereference the sub's return and assign into a hash, and then extract what you need
my %sys = %{ system_details() };
my #loglevel_vals = #{ $sys{log_level}->{values} };
my $help_msg = $sys{log_level}->{help};
The #loglevel_vals array contains FATAL, ERROR etc, while $help_msg has the message string.
This makes an extra copy of a hash while one can work with a reference, as in doimen's answer
my $sys = system_details();
my #loglevel_vals = #{ $sys->{log_level}->{values} };
But as the purpose is to interrogate the data in another sub it also makes sense to work with a local copy, what is generally safer (against accidentally changing data in the caller).
There are modules that help with deciphering complex data structures, by displaying them. This helps devising ways to work with data. Often quoted is Data::Dumper, which also does more than show data. Some of the others are meant to simply display the data. A couple of nice ones are Data::Dump and Data::Printer.
my $sys = system_details;
my $log_level = $sys->{'log_level'};
my #values = #{ $log_level->{'values'} };
my $help = $log_level->{'help'};
If you need to introspect the type of structure stored in help (for example help in operating_mode is a hash, but in log_level it is a string), use the ref builtin func.
I have a Perl script that pulls a table from a SQL database ($row variable) and attempts to do a MongoDB update like so:
my $res = $users->update({"meeting_id" => $row[0]},
{'$set' => {
"meeting_id" => $row[0],
"case_id" => $row[1],
"case_desc" => $row[2],
"date" => $row[3],
"start_time" => $row[4],
"end_time" => $row[5],
#"mediator_LawyerID" => $row[6],
"mediator_LawyerIDs" => \#medLawIds,
"case_number" => $row[6],
"case_name" => $row[7],
"location" => $row[8],
"number_of_parties" => $row[9],
"case_manager" => $row[10],
"last_updated" => $row[11],
"meeting_result" => $row[12],
"parties" => \#partyList
}},
{'upsert' => 1}) or die "I ain't update!!!";
My client now wants ICS style calendar invites sent to their mediators. Thus, I need to know whether an update or insert happened. The documentation for MongoDB::UpdateResult implies that this is how you access such a property:
my $id = $res->upserted_id;
So I tried:
bless ($res,"MongoDB::UpdateResult");
my $id = $res->upserted_id;
After this code $id is like:
HASH(0x356f8fc)
Are these the actual IDs? If so, how do I convert to a hexadecimal string that can be cast to Mongo's ObjectId type? It should be noted I know absolutely nothing about perl; if more of the code is relevant, at request I will post any section ASAP. Its 300 lines so I didn't want to include the whole file off the bat.
EDIT: I should mention before anyone suggests this that using update_one instead of update returns the exact same result.
HASH(0x356f8fc) is a Perl Hash reference. It's basically some kind of (internal) memory address of some data.
The easiest way to get the contents is Data::Dumper:
use Data::Dumper
[...]
my $result = $res->upserted_id;
print Dumper($result);
HASH(0x356f8fc) is just the human readable representation of the real pointer. You must dump it in the same process and can't pass it from one to another.
You'll probably end up with something like
`my $id = $result->{_id};`
See the PerlRef manpage for details.
See also the MongoDB documentation about write concern.
PS: Also remember that you could use your own IDs for MongoDB. You don't need to work with the generated ones.
Environment settings
OS : RHEL 6.6 (kernel 2.6.32) - x86_64
httpd : httpd-2.2.15-39
perl : 5.10.1-136
CGI API :
perl-CGI-3.15-136
perl-CGI-Session-4.35-6
I am using a static html page with Perl-CGI defined variables in the static html. This html is read in through perl, and then passed to a perl CGI script for eval.
Note:
While reading the static html, I am using UTF-8 encoding like
open( IN ,"<:encoding(UTF-8)", $file_path )
After reading the status HTML page, the output is passed back to the CGI script through a variable and then pressed in to eval to evaluate the variables.
Finally, the eval(uated) output from CGI is print which can be read through http daemon.
In the CGI script I am using
binmode(STDIN, ':encoding(UTF-8)');
binmode(STDOUT, ':encoding(UTF-8)');
The static HTML looks something like this
When I check the output of print in the CGI script, I see the complete output as desired, like this
However on the Browser, the hidden input fields are getting truncated in an unwanted manner. Like this
When I checked the wireshark output for the text/html, which is being printed back from the server to the browser, this is also getting truncated.
Like this
The HTML header has proper Content-Type and charset declaration.
The same code is working fine with EN language
The same code is working fine with zh(chinese) language as well.
When the language is set to japanese in the browser, and we read from HTTP_ACCEPT_LANGUAGE that it is 'ja', than we print the japanese specific data.
We are not using cgid module of apache.
Are we supposed to use some special encoding for japanese language??
Or it is a double encoding issue. I have tried removing the encoding when I am reading the static html file, however, that also did not help.
The same code is working fine with RHEL 5.x (2.6.18-308), and perl-CGI-Session (4.42-2), perl (5.8.8-38) httpd (2.2.3-63), there was no perl-CGI in RHEL-5.x.
I kind of found the solution to the problem. In our code we used to add a data in the CGI::Session object, which had the language. In the following form
$session->param( KEY_SESSION_LANG, $code ).
Where $session is a CGI::Session object and KEY_SESSION_LANG is 'language' and $code is something that we get from HTTP_ACCEPT_LANGUAGE. When we see 'en' we used to set it as perl constant 'en', when we got 'ja' we used to set it as perl constant 'ja'.
When we used to form the session object we used to get a session file as (perl version RHEL 5.x (2.6.18-308) & perl-CGI-Session-4.42-2 ) for JA language we used to get the following in the cgi file
cat cgisess_e31c8d21af82b59fd064babc7ca25c01
$D = {'_SESSION_ID' => 'e31c8d21af82b59fd064babc7ca25c01','_SESSION_ETIME' => 6000,'language' => 'ja','permit' => 'yes','_SESSION_REMOTE_ADDR' => '192.168.101.1','_SESSION_CTIME' => 1441090386,'execute' => 'yes','_SESSION_ATIME' => 1441090387,'_SESSION_EXPIRE_LIST' => {}};*a = \undef;;$D
For perl CGI Session in RHEL 6.6 this is coming out to be
cat cgisess_e31c8d21af82b59fd064babc7ca25c01
$D = {'_SESSION_ID' => 'e31c8d21af82b59fd064babc7ca25c01','_SESSION_ETIME' => 6000,'language' => *a,'permit' => 'yes','_SESSION_REMOTE_ADDR' => '192.168.101.1','_SESSION_CTIME' => 1441090386,'execute' => 'yes','_SESSION_ATIME' => 1441090387,'_SESSION_EXPIRE_LIST' => {}};*a = \undef;;$D
language data for ja is becoming *a. The same is also reflected when we use perl dumper for getting in memory data.
I checked the /usr/share/perl5/vendor_perl/CGI/Session.pm and it had following information in it
=head1 A Warning about UTF8
Trying to use UTF8 in a program which uses CGI::Session has lead to problems. See RT#21981 and RT#28516.
In the first case the user tried "use encoding 'utf8';" in the program, and in the second case the user tried "$dbh->do(qq|set names 'utf8'|);".
Until this problem is understood and corrected, users are advised to avoid UTF8 in conjunction with CGI::Session.
For details, see: http://rt.cpan.org/Public/Bug/Display.html?id=28516 (and ...id=21981).
=head1 TRANSLATIONS
This document is also available in Japanese.
Now when I used the perl dumper following things happened. I quote below from my offical analysis presented on our local development portal
I think the problem is because of perl-CGI-Session OSS package, please see the analysis below.
Some inputs from the CGI session source code.
## Inputs ##
From the file /usr/share/perl5/vendor_perl/CGI/Session.pm
## Following are the status of CGI session, set internally after modification to any of the parameters ##
sub STATUS_NEW () { 1 } # denotes session that's just created
sub STATUS_MODIFIED () { 2 } # denotes session that needs synchronization
sub STATUS_DELETED () { 4 } # denotes session that needs deletion
sub STATUS_EXPIRED () { 8 } # denotes session that was expired.
--snip --
I::Session - persistent session data in CGI applications
=head1 SYNOPSIS
# Object initialization:
use CGI::Session;
$session = new CGI::Session();
$CGISESSID = $session->id();
We are setting the "language" parameter in the session object. (We create a CGI object, set cookie to it, to get sid, and through sid get the session object). For setting up the language parameter we do
$session->param( 'language', ); ---> language_value = en(english) or ja(japanese). When we have completed the printing of the HTML page in /opt/packageManager/pm_gui/cgi/status.cgi file, I checked the cgi session object it is as follows
For EN Language
Before executing session flush
[09/10/2015 16:13:41] [23722] <ERROR> status.cgi : 267 :
$VAR1 = bless( {
'_STATUS' => 2,
'_DATA' => {
'_SESSION_ETIME' => 6000,
'_SESSION_ID' => '995d11334f2c39b95b3fdb86cecd9655',
'permit' => 'yes',
'language' => 'en',
Then after this when I flush the session as $session->flush() and check the session object it is
[09/10/2015 16:13:41] [23722] <ERROR> status.cgi : 270 :
$VAR1 = bless( {
'_STATUS' => 0,
'_DATA' => {
'_SESSION_ETIME' => 6000,
'_SESSION_ID' => '995d11334f2c39b95b3fdb86cecd9655',
'permit' => 'yes',
'language' => 'en',
Inference 1: session status changed after doing flush. This is good, and should be done.
For JP Language
Before executing session flush
[09/10/2015 16:14:54] [31910] status.cgi : 267 :
$VAR1 = bless( {
'_STATUS' => 2,
'_DATA' => {
'_SESSION_ID' => '1cd1b7860af4c71264f3969fe74e7a44',
'_SESSION_ETIME' => 6000,
'language' => *a
Then after this, when I flush the session as $session->flush() and check the session object it is NOT THERE. SCRIPT CRASHES HERE IT SELF
Inference 2 : Doing flush with language JP, is terminating the session, and that is why the session gets destroyed. And that is why, ending data in response is truncated
Due to the wrong value being set in memory, in session object, and then the implicit flush by CGI session is failing on the disk. Which results in termination of the session object, and in between termination of session, and and data loss of HTML.
I checked the actual code in sessions.pm file and it seems to be coming in from here
sub param {
my ($self, #args) = #_;
--snip--
# USAGE: $s->param($name, $value);
# USAGE: $s->param($name1 => $value1, $name2 => $value2 [,...]);
# DESC: updates one or more **public** records using simple syntax
if ((#args % 2) == 0) {
my $modified_cnt = 0;
ARG_PAIR:
while (my ($name, $val) = each %args) {
if ( $name =~ m/^_SESSION_/) {
carp "param(): attempt to write to private parameter";
next ARG_PAIR;
}
$self->{_DATA}->{ $name } = $val; ----> HERE
++$modified_cnt;
}
$self->_set_status(STATUS_MODIFIED);
return $modified_cnt;
}
As a solution, we stopped putting 'ja' value as a perl constant, but now are putting it as a string "ja" and it seems to be working fine now.
As a newbie to Perl I'm struggling to find a simple way to do this. I've created a very simple table in my database:
CREATE TABLE users (
id SERIAL NOT NULL PRIMARY KEY,
username TEXT NOT NULL,
password TEXT NOT NULL);
So far I used a simple login system that has a hard coded username and password that I found online:
package Example;
use Dancer ':syntax';
our $VERSION = '0.1';
set session => "Simple";
get '/' => sub {
# template 'index',{},{layout => 0};
template 'index';
};
before sub {
if (! session('user') && request->path_info !~ m{^/login}) {
var requested_path => request->path_info;
request->path_info('/login');
}
};
get '/login' => sub {
# Display a login page; the original URL they requested is available as
# vars->{requested_path}, so could be put in a hidden field in the form
template 'login', { path => vars->{requested_path} }, {layout => 0};
};
post '/login' => sub {
# Validate the username and password they supplied
if (params->{user} eq 'user' && params->{pass} eq 'letmein') {
session user => params->{user};
redirect params->{path} || '/';
} else {
redirect printf 'login failed';
}
};
get '/logout' => sub {
session->destroy;
redirect '/';
};
How do I get started with linking the database and then matching what the user inputs with what's in the database? And also when do I implement the hashing of the passwords? Any tutorials will be greatly appreciated - I've been using metacpan but it's not providing as much detail as I need!
Dancer::Plugin::Auth::Extensible takes care of a lot of boilerplate code for you. You can get a simple login system up and running without having to write any of your own /login routes as follows.
Configure Dancer::Plugin::Auth::Extensible
Install Dancer::Plugin::Database and Dancer::Plugin::Auth::Extensible::Provider::Database and add this to config.yml:
session: "YAML"
plugins:
Auth::Extensible:
realms:
users:
provider: 'Database'
disable_roles: 1
Configure database connection
Configure your database connection in environments/development.yml so that you can have different configurations for dev and production. This is what the configuration looks like for MySQL, with the connection credentials (database name, host, username, and password) stored in a separate options file database.cfg:
plugins:
Database:
dsn: 'dbi:mysql:;mysql_read_default_file=/path/to/database.cfg'
dbi_params:
RaiseError: 1
AutoCommit: 1
For Postgres, you should use a .pgpass file to store your connection credentials. Make sure the file is not world readable. See this Stack Overflow post for an example. Test that your credentials file works on the command line and that your webserver can read it.
Your existing table appears to conform to the suggested schema in the docs, but even if it doesn't, you can adjust the table and column names in the configuration.
Lock down your routes
Add the require_login keyword to a route you want to protect. A /login route will be generated automatically with a basic login form, although you can create your own if you like.
lib/MyApp.pm
package MyApp;
use Dancer ':syntax';
use Dancer::Plugin::Auth::Extensible;
our $VERSION = '0.1';
get '/' => require_login sub {
template 'index';
};
true;
(Yes, that really is all the code you have to write. I told you it takes care of a lot of boilerplate.)
Crypt::SaltedHash is used to hash passwords automatically. Note that you should never store plaintext passwords in your database; when you add a user to your database, you should generate a hash of the password and store the hash.
Note that roles are disabled in this example. If you enable roles, you can do other nifty things like only allow users with the admin role to view admin pages.
The simplest way:
Dancer::Plugin::Authorize::Credentials::PostgreSQL
Here is a good write up how to do it properly: http://perlmaven.com/storing-passwords-in-a-an-easy-but-secure-way
post '/login' => sub {
# Validate the username and password they supplied
if (!params->{user} or !params->{pass}){
redirect printf 'login failed';
}
# use your own encryption
my $auth = auth($login, encrypt($password));
# login successful
if ($auth) {
session user => params->{user};
redirect params->{path} || '/';
} else {
redirect printf 'login failed';
}
};
Regards,
Andras
Recently I have been working with Dancer to create a application, but I am having difficulties figuring out how to define the routes.
package MyApp;
use Dancer ':syntax';
our $VERSION = '0.1';
# Base for routing of requests
# Match against /:validate
any '/:validate' => sub {
# This assumes we can stop the routing here
# validate the request param in the url string
# against a regex and 'pass' the request to a
# specific route with the 'var' option
var validate => params->{validate};
.....
# Validation works and dancer passes successfully
pass();
};
# This is the part that is not working
prefix '/info' => sub {
..... # does stuff
}; ## back to the root
In the dancer logs for the pass:
[25561] core #0.001133> [hit #1]Last matching route passed! in
/usr/local/share/perl5/Dancer/Route.pm l. 216
In the dancer logs for anything after the pass:
[25781] core #0.001524> [hit #4]Trying to match 'GET /11121/info/'
against /^/info$/ (generated from '/info') in
/usr/local/share/perl5/Dancer/Route.pm l. 84 [25781] core #0.002041>
[hit #4]response: 404 in /usr/local/share/perl5/Dancer/Handler.pm l.
179
It is probably something simple I am missing, but I have not had any luck so far. Any help is greatly appreciated.
EDIT I did notice I was using prefix incorrectly so I fixed that and I apologize for the bad explanation. In a nut shell the first part of the url localhost:3000/12/ for example is a database record. All routes are build on that record being the first part of the url string so I want to validate it prior to going any further into the routes.
I was able to setup a before hook which grabs it and can work with the params hash, but it is getting a 500 error on non-matching patterns currently.
hook before => sub {
my $route_handler = shift;
var record => params->{record};
my $record = var 'record';
while ($record !~ m/^ID[\-]\d{3,6}$/) { # Check for valid ID
if ($record =~ m/^\d{3,6}$/) { # Works currently
$record = 'ID-'.$record;
}else {forward "/error"}; # this = 500 ISE error
}
};
I tried a forward and send_error but both generate an ISE and Dancer reports this on the last entry in the log:
29661] core #0.001048> [hit #2]entering before hook in
/usr/local/share/perl5/Dancer/Hook.pm l. 58
Any help is greatly appreciated, also an edit to make my question more clear is welcomed.
That is not what prefix does. Prefix is used to declare the prefix of the routes in the current package.
prefix '/users';
get '/' => sub { ... }; # matches /users
post '/add' => sub { ... }; # matches /users/add
get '/view/:id' => sub { ... }; # matches /users/view/123
I haven't worked with Dancer at all, but from the Dancer::Introduction docs, it looks like you also have to define a route inside the prefix /info. Try with:
# This is the part that is not working
prefix '/info' => sub {
get '/' => sub {
..... # does stuff
}
}; ## back to the root