Perl difficulty passing values to function - perl

Cannot understand why the returned values from the function login bellow do not correspond to what is passed to it.
The following is a snippet of my code
package This_package;
.......
# returned from function that parses post data ($reqparam)
my $thisuser = $$reqparam{"username"};
# escape '#', username is an email
$thisuser =~ s/#/\#/;
my $thisuser_pass = $$reqparam{'password'};
print $thisuser; # ok
print $thisuser_pass; # ok
my $obj = new users;
my $valid_user = $obj->login($thisuser, $thisuser_pass);
.......
package Another_package;
sub new {
my ($class) = #_;
my $self = {
_login => undef,
_create_user => undef,
....
};
bless $self, $class;
return $self;
}
sub login ($$){
my ($user, $pass) = #_;
# some processing
.....
return $user; # prints users=HASH(...)
# return $pass; # prints the value of $user (the actual value)
# instead of the value of $pass
}
While trying to learn perl by converting some code from php into perl.
I have run into this problem, I have tried a few alternatives but obviously there is something I am not getting!

When you call a function like
my $valid_user = $obj->login($thisuser, $thisuser_pass);
The first parameter is this usually done as
sub login
{
my ( $self , $user , $password ) = #_;
}
You are missing $self
Because you are missing $self you user is actually the object and your password is actually the user.
If you are coming from another objected oriented language like C++ , Java or C#, this is a perl gotcha (no pun intended :)) . Another one is that even from an object method if you want to invoke another member method you have to use self like
$self->callAnotherObject( $user );
Simply calling wont do
callAnotherObject( $user );
Also I see that you are using function prototypes, It may not work as you intend it to be.

When you use object-oriented syntax ($obj->login($thisuser, $thisuser_pass)) to call a subroutine, the first argument will be the object itself. You should say, and you will typically see object-oriented modules use syntax like:
sub login {
my ($self, $user, $pass) = #_;
...
}
Incidentally, you shouldn't use prototypes ( ($$) ) without a good reason. Prototypes in Perl are not used in the same way they are in other languages, and in any case the prototype is ignored when you call a subroutine with indirect syntax (luckily, in your case, since you are actually calling it with 3 arguments).

You even watch Mythbusters?
Although you see Adam and Jamie do really, really dangerous stuff, they warn you at the beginning of every program, "Don't do this at home." Think of Perl prototypes in the same way. If you use them, there's a good likelihood you'll get badly burned.
Okay, now who is calling your login function? Or, maybe better, how is it called?
If I use your Perl module, do I call your login subroutine from my main program like this?
my $package_obj = Another_package->new;
$package_obj->login($user, $password);
Or, is this some subroutine that you use in your package for your convenience and you use it as a simple subroutine, and not a private method like this:
package Another_package;
sub new {
...
}
sub foo {
...
my $user = login ($user, $password);
}
If you're calling your login subroutine as a simple subroutine inside your package as in the second example, everything should be fine.
However, if you're treating your login subroutine like a full fledge method (like I do in the first example), you must remember that methods pass their class object as the first parameter of the subroutine.
Thus, you'll need to do something like this:
sub login {
my $self = shift; #Pointer to the Another_package object I'm using
my $user = shift;
my $password = shift; #I just love lining things up!
$self->{USER} = $user; #Bad way of doing it.
$self->{PASSWD} = $password;
... #Some processing.
return $user;
}
Why the #Bad way of doing it comment? Because you really want to keep your internals as separate as possible. That way, if you make a change to the structure of the Another_package class, your changes are isolated in a very specific part of your code. It makes debugging much easier.
A better way of writing the login subroutine would be:
sub Login { #In standard Perl, methods are capitalized.
my $self = shift; #Pointer to Another_package object
my $user = shift; #Allow user to pass user and password in constructor
my $password = shift; #I just love lining things up!
$self->User($user); #Way better: This is a setter/getter method
$self->Password($password);
... #Some processing.
return $user;
}
In this example, I'm using setter/getter methods for setting my user name and password. This way, I don't have to worry how they're actually stored in my object.
Here's your Another_Package module using setter/getter methods. I now allow the user to pass in the user and password when they call the new constructor if they'd like.
package Another_package;
sub new {
my $class = shift;
my $user = shift;
my $password = shift;
my $self = {};
bless $self, $class;
$self->User($user);
$self->Password($password);
...
return $self;
}
sub Login {
my $self = shift;
my $user = shift;
my $pass = shift;
$self->Password($pass);
if (not defined $self->User($user)) {
croak qq(Cannot log in without a user ID);
}
...
if ($login_successful) {
return $self->User; #Or maybe a session instant
else {
return;
}
}
Notice in my new constructor subroutine I create a $self anonymous hash (my $self = {}) and I immediately bless it. Now, $self is already a package object, and I can call a bunch of setter/getter methods to set the various fields in my object. My new constructor has no idea what my actual Another_module object looks like.
In my Login method subroutine, I also use the same setter/getter methods to set user and password. Again, my Login method knows nothing on how these fields are stored in the object.
One more thing you might notice is that I'm setting a scalar called $login_successful in my Login module to see whether or not my login was successful. In Perl, it is common to return nothing if the method fails, or return something on success. This way, the user's program can test to see if the call succeeded or failed. For example, maybe if the login fails, the user might want to try some default passwords before giving up:
my $package_obj = Another_package->new($user, $password);
my $foo = $package_obj->Login;
if (not defined $foo) {
foreach my $password qw(swordfish s3x mon3y 7ucky) {
$package_obj->Password($password);
last if $foo = $package_obj->Login;
}
if (not defined $foo) {
die "I don't know the password :-(";
}
}
So, what do my setter/getter methods look like? They're actually pretty simple:
sub User {
my $self = shift;
my $user = shift;
if(defined $user) {
$self->{USER_INFO}->{USER} = $user;
}
return $self->{USER_INFO}->{USER};
}
sub Password {
my $self = shift;
my $pass = shift;
if (defined $password) {
$self->{USER_INFO}->{PASSWORD} = $pass;
}
return $self->{USER_INFO}->{PASSWORD};
}
Why do I store $user in $self->{USER_INFO}->{USER} and not $self->{USER}? No reason a at all. However, it does show that the rest of the Another_package module doesn't care where or how I store the user and password.

Related

Can't read from app.conf file in Perl

I have subroutine in perl that accepts parameters. Now I am trying to read from the config file using the below code.
sub user{
my $self = shift;
my $apiBaseUrl = $self->app->config->{"apiBaseUrl"};
my $apiToken = $self->app->config->{"apiToken"};
}
But I am getting the error
Can't locate object method "app" via package "test#example.com" (perhaps you forgot to load "test#example.com"?)
The parameters I am passing to the subroutine are $username and $password
This is how I am calling that subroutine, with an email and password which I get from login form.
my $username = $self->param('username');
my $password = $self->param('password');
user($username, $password);
Below is the full code in the file.
use Mojo::Base 'Mojolicious::Controller';
use Mojo::UserAgent;
sub is_logged_in {
my $self = shift;
return 1 if $self->session('logged_in');
$self->render(
inline => "<h2>Forbidden</h2><p>You're not logged in. <%= link_to 'Go to login page.' => 'login_form' %>",
status => 403
);
}
sub user {
my ($username, $password) = #_;
my $self = shift;
my %returnResult;
my $apiBaseUrl = $self->app->config->{'apiBaseUrl'};
my $apiToken = $self->app->config->{'apiToken'};
my $url = $apiBaseUrl.'/auth/login/check?email='.$username.'&password='.$password.'';
my $header = {'api-token' => $apiToken};
my $ua = Mojo::UserAgent->new;
my $res = $ua->post( $url => $header )->result;
if($res->is_success)
{
my $content= $res -> json;
my $decoded_email = $content->{'email'};
$returnResult{'fn'} = $content->{'fn'};
$returnResult{'ln'} = $content->{'ln'};
$returnResult{'roles'} = $content->{'roles'};
if($username eq $decoded_email)
{$returnResult{'logged_in'} = 1;}
else
{$returnResult{'logged_in'} = 0;}
return %returnResult;
}
else
{
return $res->status_line;
}
}
sub on_user_login {
my $self = shift;
my $username = $self->param('username');
my $password = $self->param('password');
my %userDetails = user($username, $password);
if ($userDetails{'logged_in'} == 1) {
$self->session(logged_in => 1);
$self->session(username => $username);
$self->session(userDetails => \%userDetails);
$self->redirect_to('restricted');
} else {
$self->flash(message => 'Incorrect username/password!');
$self->redirect_to('/');
}
}
1;
What am I doing wrong?
my $username = $self->param('username');
my $password = $self->param('password');
user($username, $password);
You are using your user sub as a function, and not as a method. Perl is a very flexible programming language that allows you to mix functional, procedural and object oriented programming styles in the same program. Sometimes that can get confusing.
You can recognize OOP (object oriented programming) in Perl when a sub has $self as the first argument because there is a convention to always name the object itself like that. Other languages use this instead. Another giveaway is when there is a variable followed by an arrow -> followed by an identifier.
$obj->method(#args);
You've already done that in your code when you got the parameters from $self. I suspect you are using this in a Mojolicious::Controller, and you've put your sub user in the same file.
The error message you are seeing is because your first argument to the function is the email address in $username. You left out the $self-> part, which tells Perl to call this as a method on $self. Under the hood, it will look into the identifier on the left (which is $self) to see what class that thing has. It will then look into the namespaces (called packages in Perl) of all the things in the inheritance tree of that class to find the identifier on the right (which is user). In our case, it will find a sub user right in this same package. It then calls that function user and passes the thing on the left ($self) as the first argument, and $username and $password as the second and third arguments.
So what you need to do is:
$self->user($username, $password);
The code in your sub is correct (but does not actually use the two arguments).

Error while creating an instance by using $self in a perl script

I try to create an object inside my perl Script. Therefore I have a constructor
new(;#)
{
my $class = shift;
my $self = {};
bless $self, $class;
$self->_init(#_);
return $self;
}
And my _init(;#) Function, to initialise the object
my $self = shift;
if( #_ )
{
my %extra = #_;
#$self{keys %extra} = values %extra;
}
return;
Am I using this two functions the wrong way? I am starting every other sub with the two lines
my $self = shift;
croak "instance method called for class" unless ref $self;
But I get only syntax / String found where operator expected errors in return for every single time I am using it.
Therefore my Question: Am I using the two functions the right way? I always thought I only need to initialise $self once, like I did, and can point everything I want to it for the rest of the Script.
croak is not loaded by default. You must use Carp in the package to be able to use it (see Carp).
BTW, prototypes are ignored with method calls. Don't use them. Don't use them for functions, either.
You might use something like Class::Declare::Attributes to save some typing:
sub new :class {
...
}

How to access object features in Perl from within the same package

I'm making a Perl module and I am still getting to grips with how Perl deals with objects.
This is the new sub that I wrote to create an object and I have no problem updating elements:
sub new {
my $class = shift;
my ($self) = {
name => undef
};
bless($self, $class);
return $self;
}
sub get_name {
my $self = shift;
$self->{name} = 'Eve';
return $self->{name};
}
I can use the object fine when I call the module and access it from another file, but I want to use the data in the object at other areas in the module code.
So I have no problem doing this:
my $new_object = new ProgramTest; # ProgramTest being the module/package
my $name = get_name();
But I want to use the $self elements in a 'module-internal' method which is never accessed by an outside script. So I want to have something like this:
sub get_variables {
return (name); # I don't know how to get the name here
# (I plan to have other variables, too)
}
I am probably missing something obvious (I'm sure I'll kick myself when I see the solution), so any help appreciated!
I want this so that the rest of the module can use the variables (without changing) as there are conditions that rely on their values.
There's no such thing as internal/private methods in perl objects. Common practise is to start any methods which should not be used publicly with an underscore, but this is not enforced in any way. Also have a look at moose - it takes a lot of the hassle out of OO perl.
With regards to your question the below shows how one module method can call another module method, with both having access to the object data. Again I woulds really recommend you use Moose!
sub publicSub{
my ( $self ) = #_;
return $self->_privateSub();
}
sub _privateSub{
my ( $self ) = #_;
return $self->{name};
}
I think you want class-variables. They are global to a class and all instances of the class (i.e. all the objects you created) can see them. Global in this case means that they are at the ouside-most lexical scope, so all subs can see them.
package ProgramTest;
my $everyone_can_see_this = 1; # lexical scope, but 'global' to the package
sub new {
my $class = shift;
my ($self) = {
name => undef
};
bless($self, $class);
return $self;
}
sub get_var {
my $self = shift;
return ++$everyone_can_see_this;
}
package Main;
my $o1 = ProgramTest->new;
my $o2 = ProgramTest->new;
say $o1->get_var;
say $o2->get_var;
say $o1->get_var;
__END__
2
3
4
But I don't see why you would want to do that. It doesn't make sense (unless you want an object-counter). Don't use it for config values, or you cannot really have objects for different purposes of the same class.
Maybe you want something else. If so, please try to rephrase your question.

How can I call methods on a tied variable?

I've just started to learn about tie. I have a class named Link which I would like to do the following thing:
if fetched, return the link's address
if stored, store the new address
be able to call methods on it
So far, my code is :
package Link;
sub FETCH {
my $this = shift;
return $this->{"site"};
}
sub STORE {
my ($self,$site) = #_;
$self->{"site"} = $site;
}
sub print_method {
my $self = shift;
print $self->{"site"};
}
sub TIESCALAR {
my $class = shift;
my $link = shift;
my $this = {};
bless($this,$class);
$this->{"site"} = $link;
return $this;
}
1;
And the code I'm using to check the functionality is:
use Link;
tie my $var,"Link","http://somesite.com";
$var->print_method;
When ran, the script will terminate with the following error:
Can't call method "print_method" without a package or object reference at tietest.pl line 4..
If I understand its message correctly, $var->print_method resolves to some string upon which the method print_method is called. How could I benefit from tie, but also use the variable as an object?
EDIT: after experimenting a bit,I found out that if I return $self on fetch , I can call the methods , however , fetch won't return the address .
EDIT 2:the perl monks supplied me the solution : tied . tied will return a reference to the object VARIABLE .
By combining tied with my methods , I can accomplish everything I wanted .
Tie is the wrong tool for this job. You use ties when you want the same interface as normal data types but want to customize how the operations do their work. Since you want to access and store a string just like a scalar already does, tie doesn't do anything for you.
It looks like you want the URI module, or a subclass of it, and perhaps some overloading.
If you really need to do this, you need to use the right variable. The tie hooks up the variable you specify to the class you specify, but it's still a normal scalar (and not a reference). You have to use the object it returns if you want to call methods:
my $secret_object = tie my($normal_scalar), 'Tie::Class', #args;
$secret_object->print_method;
You can also get the secret object if you only have the tied scalar:
my $secret_object = tied $normal_scalar;
I have an entire chapter on tie in Mastering Perl.
I suggest making a normal Perl object and then overloading stringification. You lose the ability to store a value through assignment, but retain the ability to get the value out by printing the object. Once you start wanting to call methods directly, an object is probably what you want.
package Link;
use strict;
use Carp;
use overload
(
'""' => sub { shift->site },
fallback => 1,
);
sub new
{
my $class = shift;
my $self = bless {}, $class;
if(#_)
{
if(#_ == 1)
{
$self->{'site'} = shift;
}
else { croak "$class->new() expects a single URL argument" }
}
return $self;
}
sub site
{
my $self = shift;
$self->{'site'} = shift if(#_);
return $self->{'site'};
}
sub print_method
{
my $self = shift;
print $self->site, "\n";
}
1;
Example usage:
use Link;
my $link = Link->new('http://somesite.com');
print $link, "\n"; # http://somesite.com
$link->print_method; # http://somesite.com
If you really, really want assignment to work too, you can combine a normal object with overloaded stringification (Link, above) with tie:
package LinkTie;
use strict;
use Link;
sub FETCH
{
my $this = shift;
return $this->{'link'};
}
sub STORE
{
my($self, $site) = #_;
$self->{'link'}->site($site);
return $site;
}
# XXX: You could generalize this delegation with Class::Delegation or similar
sub print_method
{
my $self = shift;
print $self->{'link'}->print_method;
}
sub TIESCALAR
{
my $class = shift;
my $self = bless {}, $class;
$self->{'link'} = Link->new(#_);
return $self;
}
1;
Example usage:
tie my $link,'LinkTie','http://somesite.com';
print $link, "\n"; # http://somesite.com
$link->print_method; # http://somesite.com
$link = 'http://othersite.com';
print $link, "\n"; # http://othersite.com
$link->print_method; # http://othersite.com
This is all quite hideous and a long way to go just to get the dubious ability to assign to something that you can also call methods on and also print as-is. A standard URI object with stringification is probably a better bet.

How do I override autogenerated accessors in Perl's Class::DBI?

I followed the example at http://wiki.class-dbi.com/wiki/Overriding_autogenerated_accessors
I want to modify the URL before it is inserted to the database:
package Hosting::Company;
use base 'Class::DBI';
my $class = __PACKAGE__;
$class->table('Companies');
$class->columns(Primary => 'CompanyId');
$class->columns(Others => qw/Name Url Comment/);
sub Url {
my $self = shift;
# modify URL.
if (#_) {
$_[0] = 'aaaaaaaaaaaa';
# return $self->_Url_accessor('aaaaaaaaaaaa'); - doesn't work either
}
# Back to normal Class::DBI
return $self->_Url_accessor(#_);
}
But it doesn't work:
my $company = Hosting::Company->insert({ Name => 'Test', Url => 'http://http://url' });
print $company->Url, "\n";
Shows:
http://http://url
I wish the Class:DBI mailing list were still alive!
In you URL accessor, you check whether a parameter was passed to that method. But you aren't passing anyhting in so the accessor will do nothing but call _Url_accessor(). You should probably call _Url_accessor first and then modify the result:
sub Url {
my $self = shift;
# Was there a param passed in?
if ( #_ ) {
# Do you really want to modify it here?
return $self->_Url_accessor(#_);
}
else {
my $url = $self->_Url_accessor();
# mangle result here:
$url = 'aaaaaaaaa';
return $url;
}
}
If you want to change the URL before it even goes in the database, I guess you must provide a normalize_column_values in your class and this will be called each time an insert is made.
Overriding an accessor does not change insert. The best way to handle data normalization is to override normalize_column_values(). But Manni is right, your accessor is busted.
PS The CDBI mailing list is still active, just hasn't seen much posting. Most have moved on to DBIx::Class.