I am trying to make a tinier, more optimized CGI module for Perl.
When working on the init subroutine to get, or set default file data, I run into an issue primarily caused with the MIME::Types module.
In reality, my init subroutine is supposed to get the blessed variables from the new constructor, initialize MIME::Types, use MIME::Types to return the MIME::Type of $type via mimeTypeOf(), determine if the MIME::Type is binary, and print out the Content-Type and Content-Disposition.
However, when trying to do something of that nature, I get the title as the error.
This is my current code, which in theory should work.
sub new {
my ($class, %args) = #_;
my $self = {};
my $type = $args{type} // 'text/html'; # If type isn't defined, default to HTML content.
my $attachment = ($args{attachment} // 'false') eq 'true' ? 'attachment' : 'inline'; # Same, but with disposition instead.
$self->{type} = $type;
$self->{attachment} = $attachment;
bless $self, $class;
return $self;
}
sub init {
my $self = shift;
CORE::state $type = shift // $self->{type}; # If there are no overrides, just use $self->type;
# print $self->type; prints text/html when not specified.
CORE::state $attachment = shift // $self->{attachment}; # Same as above, but with $self->attachment;
# print $self->attachment; prints inline when not specified.
my $types = MIME::Types->new;
my $mime = $types->mimeTypeOf($type);
if ($mime->isBinary) {
$self->{attachment} = 'attachment';
} else {
$self->{attachment} = ('inline' or $attachment);
}
die "Warning: Binary content types should not be sent inline!\r\n" if ($mime->isBinary && $attachment eq 'inline');
print "Content-Type: $mime\r\nContent-Disposition: $self->{attachment}\r\n\r\n";
return;
}
Even printing the types return a non undefined value, in fact, it prints out what it's supposed to when there's nothing inside of the new method. This is the code which is in my main CGI file.
#!C:\Strawberry\perl\bin\perl.exe
use strict;
use warnings;
use TinyCGI::Core;
# Create a new TinyCGI::Core object
my $cgi = TinyCGI::Core->new();
# Initialize the TinyCGI::Core object
$cgi->init();
print 'Hello, World!';
This worked perfectly fine without MIME::Types, and even works just fine with stuff actually defined within the object.
I've also tried not using CORE::state.
You are using MIME::Types incorrectly. It looks like you want to take the value from an HTTP header (or maybe multi-part body header) and figure out what it is. You are using mimeTypeOf, which expects a file extension or filename, when you should be using type, which expects a type string.
Either way, there's a chance that you could get back an undef value because MIME::Types might not be able to map the string to a type. You should guard against that:
my $type = $mime->type( $self->{type} );
if( defined $type ) { ... }
Unrelated to that, you are using CORE::state for some reason. That makes it look like you are defining some method or subroutine named state and expecting it to conflict with the Perl built-in.
But I don't think you want state here. You have an instance method init that is for some reason persisting a value based on an earlier created, unrelated instance. I think you want my, since you are merely giving a local name to something that's already inside the invoking instance. You don't want to persist that to the next instance that calls this.
Related
I'm getting this error and cannot understand why this happens. It happens when I jump to another subroutine. Perhaps there is something I need to understand about Mojolicious on why this happens.
Here is the source code of my program:
#!/usr/bin/perl
use Mojolicious::Lite;
get '/' => sub { &start_home; };
app->start;
sub start_home {
my $d = shift;
my $something = $d->param('something');
### Do things with $something.... etc.. etc..
&go_somewhere_else; ### Go somewhere else
}
sub go_somewhere_else {
my $c = shift;
$c->render(text => "Hello World!");
### End of program
}
I am passing a value on to the renderer and there is a value - Why would it say it is undefined? My understanding is that this only happens if you jump to a subroutine and try to render output.
My operating system is Windows and I am using Strawberry Perl.
You need to pass the context object $c/$d to your second function. The undefined value is your $c in go_somewhere_else, because you call it without a parameter.
Initially, to make it work, do this.
sub start_home {
my $d = shift;
my $something = $d->param('something');
go_somewhere_else($d);
}
You are now passing the context, which you named $d (that's not the conventional name), to the other function, and the warning will go away.
That's because the form &subname; without parenthesis () makes #_ (that's the list of arguments to the function) available inside of go_somewhere_else, but because you shifted $d off, #_ is now empty, and hence your $c inside go_somewhere_else is undef.
Alternatively, you could also change the shift to an assignment with #_. But please, don't do that!
sub start_home {
my ( $d ) = #_;
my $something = $d->param('something');
&go_somewhere_else;
}
There are more things odd to the point of almost wrong here.
get '/' => sub { &start_home; };
You are currying the the start_home function, but you are not actually adding another parameter. I explained above why this works. But it's not great. In fact, it's confusing and complicated.
Instead, you should use a code reference for the route.
get '/' => \&start_home;
Inside of start_home, you should call your context $c as is the convention. You should also not use the ampersand & notation for calling functions. That changes the behavior in a way you most certainly do not want.
sub start_home {
my $c = shift;
my $something = $c->param('something');
# ...
go_somewhere_else($c);
}
To learn more about how function calls work in Perl, refer to perlsub.
I am still learning some object oriented perl and I am struggling a bit on how to access my classes.
I've successfully created a class which one of its attributes is a hash. When I want print directly the value of a given key in this hash, the output is always blank. If I assign a new variable to the value of the hash, then I can print this variable.
Toy example code:
sub new {
my($clas) = #_;
my($self) = {};
bless($self,$clas);
$self->{age_record} = {};
return($self);
}
Imaginary code that fills up my hash
my $class->new("class");
fill_hash($class);
Let's use Data::Dumper to see what's in the hash.
print Dumper $class->{age_record};
$VAR1 = {
'Rigobert' => 17,
'Helene' => 42
};
I get nothing if I print directly.
print $class->{age_record}{'Rigobert'};
But if I asign it first to a new variable, it works.
my $age = $class->{age_record}{'Rigobert'};
print "Age is : $age\n";
I get
Age is : 17
What am I doing wrong when referencing the hash attribute?
As far as I can see there is nothing wrong, and the only reason I can think of for your output not appearing is that it is buffered. You should try adding
STDOUT->autoflush;
near the top of your program.
However, you shouldn't be accessing internal data structures from the calling code. fill_hash should be a better_named method and you need to write an accessor method to get to the age_record element. Something like this
sub pupil_age {
my $self = shift;
my ($name) = #_;
$self->{age_record}{$name};
}
and then you can call it as
printf "Age is : %d\n", $class->pupil_age('Rigobert');
(The printf is just a style choice — there's no other need to use it above a simple print)
I'm puzzled by the line
my $class->new("class");
It should be something like:
my $class = Class->new();
(Assuming that your class's name is "Class" - it's pretty confusing having a class called "Class". I'm assuming that you have class modelling an academic class!)
Then you'd have a method to add a pupil.
sub add_pupil {
my ($self, $name, $age) = #_;
$self->{age_record}{$name} = $age;
}
And another method to get a pupil.
sub get_pupil {
my ($self, $name) = #_;
return $self->{age_record}{$name};
}
You'd then use it like this.
my $class = Class->new();
$class->add_pupil('Rigobert', 17);
$class->add_pupil('Helene', 42);
print $class->get_pupil('Rigobert'); # prints 17
I think you're confused because you haven't really thought about how you are modelling your data inside the class. And I can't be much more help as I don't know what the other attributes are or what your fill_hash() subroutine looks like.
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.
I'm a bit messed up with the following:
I have a function that calls subroutines in the following way:
sub someFunction {
my $self = shift;
my $type = $self->{'type'};
if($type eq 'one_subroutine') {
$self->updateOneSubroutine();
}
elsif($type eq 'another_one_sub') {
$self->updateAnotherOneSub();
}
(...)
else {
die "Unsupported '$type'";
}
I have to change this to let each subroutine be coded in its own file, include all available files, and automagically call the subroutine inside.
I did this in a test file with the following code:
# Assume a routines subdir with one_subroutine.pm file with
sub updateOneSubroutine(){
$self = shift;
$self->doSomeThings();
(...) #my code
}
1;
test.pl
# Saves in routines hash_ref a pair of file_name => subRoutineName for each file in routines subdir.
# This will be used later to call subroutine.
opendir(DIR,"lib/routines") or die "routines directory not found";
for my $filename (readdir(DIR)) {
if($filename=~m/\.pm$/){
# includes file
require "lib/routines/$filename";
# get rid of file extension
$filename=~s/(.*)\.pm/$1/g;
my $subroutine = "update_${file}";
# camelizes the subroutine name
$subroutine=~s/_([a-z0-9])/\u$1/g;
$routine->{ $filename } = $subroutine;
}
}
{
no strict "refs";
$routine->{$param}();
}
where param is something like "one_subroutine", that matches with a filename available.
Since each subroutine receives $self in the call, I should call the routine by $self->something();
I've tried $self->$routine->{$param}() , $self->${routine->${param}}() and many other things without success. I've checked chapter 9 "dynamic subroutines" of mastering perl, and a similar question to perl monks, but I can't still figure out how to reference the subroutine in a way that represents $self->updateAnotherOneSub() , or something similar that lets $self be read as a param in those subroutines.
Thanks in advance, Keber.
This seems a bit like an X/Y problem. What exactly are you trying to do? If it is to reduce loading time, then modules like AutoSplit/AutoLoader might be of interest to you.
If it is to create some sort of data structure of subroutines, you should be installing anonymous subs into a hash, rather than giving them all names.
Given a subroutine reference:
my $code = sub {...};
you would call it as:
$self->$code(...);
If instead you have a subroutine name, you can lookup the coderef:
my $code = 'Package::With::The::Subroutines'->can('method_name');
and if that succeeds (check it), then you can use $self->$code(...) to call it.
Given this code:
{
no strict "refs";
$routine->{$param}();
}
You would pass $self to the routine with:
{
no strict "refs";
$routine->{$param}($self);
}
Or you could approach it the way I did above with can:
'package'->can($routine->{$param})->($self)
if you don't want to turn off strict 'refs'
Try to extract the method name first, then it should work. I did a small test script that may do something like you want to, so:
my $method = $routine->{$param};
$self->$method->();
You can and of course should check, if the desired method exists like Eric said:
if ($self->can($method)) {
$self->$method->();
}
The important part here is, that you extract the method name so you have it in a single variable; otherwise perl won't figure that out for you - and as far as I know there is no way of setting parens or braces to do so.
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.