I am getting
$VAR1 = bless( \*{'Fh::fh00001Screenshot.png'}, 'Fh' );
in a variable. But I need to retrieve fh00001Screenshot.png from it. How can I get it?
The Fh package is used internally by the CGI module to handle temporary files used for building multipart data. You shouldn't be using it directly.
Check carefully to make sure there is no better way before using this code which comes from the CGI code for Fh::asString
(my $name = $$VAR1) =~ s/^\*(\w+::fh\d{5})+//;
print $name;
output
Screenshot.png
Update
Rather than picking bits out of the CGI code, it looks like this package - which should really be a private one - is accessible from calling code. Use just $var->asString instead, like this
use strict;
use warnings;
use CGI;
my $var = do {
no strict 'refs';
my $var = bless( \*{'Fh::fh00001Screenshot.png'}, 'Fh' );
};
print $var->asString;
Related
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 was trying to tie an hash (or hashref) in order of tracking variable usages.
Everything is working for simple cases, but when I tried to use my module on some real code I had this error:
hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)
I've replicated the error using the following code:
use Tie::Hash::Usages;
use JSON;
my #arr = (
{
key1 => "ac",
key2 => 12,
key3 => 12
},
);
my %tied_hash;
tie %tied_hash, 'Tie::Hash::Usages';
$tied_hash{key1} = \#arr;
my #val = $tied_hash{key1};
print encode_json(\#val)."\n\n"; #this works
print encode_json($tied_hash{key1}); #this doesn't
The same code works with a plain hash.
I'd need this to work also in the second case, the code base is huge and I don't want to change it or live with the doubt that something somewhere will not work in some particular case.
Usages.pm (simplified)
package Tie::Hash::Usages;
use strict;
use warnings;
use Tie::Hash;
use vars qw(#ISA);
#ISA = qw(Tie::StdHash);
sub TIEHASH {
my ($class, $tracker, $filename) = #_;
my %hash;
bless \%hash, $class;
}
sub STORE {
my ($self, $key, $val) = #_;
$self->{$key} = $val;
}
sub DELETE {
my ($self, $key) = #_;
delete $self->{$key};
}
sub FETCH {
my ($self, $key) = #_;
return $self->{$key};
}
sub DESTROY {
my $self = shift;
}
1;
perl version: v5.18.2
Minimal demonstration:
use JSON::XS qw( encode_json );
use Tie::Hash qw( );
our #ISA = 'Tie::StdHash';
{
tie my %tied, __PACKAGE__;
$tied{data} = { a => 1 };
encode_json($tied{data}); # Exception: hash- or arrayref expected ...
}
JSON is a front-end for JSON::PP (default) or JSON::XS (if found). This is a problem with JSON::XS.
A lot of XS code doesn't handle magical variables (which is what $tied{EXPR} returns), and while JSON::XS has handled magical values since version 1.2, it doesn't for the value directly passed to encode_json.
This is an existing bug in JSON::XS that can be worked around as follows:
encode_json(my $non_magical = $tied{data})
Bug reported.
Unable to replicate using the code given, so what you're providing doesn't seem to be representative of your actual situation. The only thing I see that's the tiniest bit off is this line:
my #val = $tied_hash{key1};
in which you're assigning a scalar (your stored arrayref) to an array. Perl handles this fine, assembling an array with the scalar as sole content, but if your actual use case involves something more complex (maybe something with sub prototypes involved), conceivably something might be going wrong there.
Ether got it right. JSON library uses JSON:XS by default (which creates this issue). All I had to do is uninstall JSON::XS and install JSON::PP
sudo cpan
install cpan App::cpanminus
exit
sudo cpanm --uninstall JSON::XS
sudo cpan
install JSON::PP
exit
Hope this helps someone.
I am getting an error when using Rose::DB.
#MyApp/DB.pm
package MyIMDB::DB;
use strict; use warnings;
use base qw(Rose::DB);
__PACKAGE__->use_private_registry;
__PACKAGE__->register_db (
driver => 'SQLite',
....
);
1;
# MyApp/DB/Object.pm
package MyApp::DB::Object;
use strict; use warnings;
use MyApp::DB;
use base qw(Rose::DB::Object);
sub init_db { MyIMDB::DB->new }
1;
#
package MyApp::Users; #controller
use strict; use warnings;
use base 'Mojolicious::Controller';
use Mojo::ByteStream 'b';
use MyApp::Models::User;
use Data::Dumper;
sub my_action {
my $uc = shift;
my $err = MyApp::Models::User::->validate(...); #extra ::
# http://perldoc.perl.org/perlobj.html#Invoking-Class-Methods
}
# MyApp/Models/User.pm # 2 packages in this file
package MyApp::Models::User::Manager;
use base qw(Rose::DB::Object::Manager);
use MyApp::Models::User;
sub object_class { 'MyApp::Models::User'}
__PACKAGE__->make_manager_methods('users');
# class methods get_x, get_x_iterator, get_x_count, delete_x, update_x
1;
MyApp::Models::User
use strict; use warnings;
use base qw(MyApp::DB::Object);
__PACKAGE__->meta->setup(
#setup tables, columns....
);
sub validate {
my $u = shift;
my $n = MyApp::Models::User::Manager::->get_users_count(query => [user_name => $user]);
}
1;
The error I get is:
"Can't use string ("MyApp::Models::User") as a HASH ref while "strict refs"
in use at /usr/local/share/perl/5.18.2/Rose/DB/Object.pm line 91, <DATA> line 2231."
The entry point is my_action() method of MyApp:Users class.
I tried alternative setups of creating class MyApp::Models::User::Manager : separate .pm file, make_manager_class(), but to no avail.
(I found this discussion from 2007 with the same error message, but it does not help me out http://comments.gmane.org/gmane.comp.lang.perl.modules.dbi.rose-db-object/1537).
This may indicate I am trying to call an object method as if it were a class method. I tried the tricks listed here http://perldoc.perl.org/perlobj.html#Invoking-Class-Methods, but no success.
I now I can examine the contents of variables with Data::Dumper, but I have no clue what to dump as there are very little data structures used.
While use strict is a good idea when writing Perl code, you may want to relax the strict-ness by adding
no strict `refs`;
to get past the current error. As #ikegami pointed out another way to fix this is to get rid of the bad reference, but if you don't want to rewrite the module working around it with relaxing strict-ness is your best bet.
Given the following module:
package My::Object;
use strict;
use warnings;
use My::Module::A;
use My::Module::B;
use My::Module::C;
use My::Module::D;
...
1;
I would like to be able to call My::Object in the next 2 scenarios:
Normal use
use My::Object;
My::Module->new();
Reduced memory use. Call the same object but with a condition or a flag telling the object to skip the use modules to reduce memory usage. Somehow like:
use My::Object -noUse;
My::Module->new();
If tried the Perl if condition without success.
The problem I'm having it's with big objects with a lot of uses, then only loading this object consumes a lot of RAM. I know I can refactor them but it will be wonderful if somehow I can avoid these uses when I'm sure none of them is used on the given scenario.
One solution will be to replace all uses with requires on all places when the modules are needed, but I don't see convenient when some of them are used in a lot of methods.
Any ideas?
Thanks
The native pragma autouse will load modules needed when plain subroutines are called:
use autouse 'My::Module::A' => qw(a_sub);
# ... later ...
a_sub "this will dynamically load My::Module::A";
For proper OO methods, Class::Autouse will load modules (classes) when methods are called:
use Class::Autouse;
Class::Autouse->autouse( 'My::Module::A' );
# ... later ...
print My::Module::A->a_method('this will dynamically load My::Module::A');
What I think you're looking for is perhaps require - require is evaluated later so you can use it successfully in a conditional:
if ( $somecondition ) {
require Some::Module;
}
Of course, you won't be able to do Some::Module->new() if you've not loaded it - there's just no way around that.
Where use is triggered at compile time (and thus will trigger warnings under perl -c if the module is unavailable) require happens are runtime. You should probably test if require was successful as a result.
e.g.:
if ( $somecondition ) {
eval { require Some::Module };
warn "Module Not loaded: ".$# if $#;
}
Otherwise you may be looking for:
Is it possible to pass parameters to a Perl module loading?
#!/usr/bin/perl
package MyObject;
sub import {
my ( $package, $msg ) = #_;
if ( defined $msg and $msg eq "NO_USE" ) {
#don't load module
}
else {
require XML::Twig;
}
}
1;
And then call:
use if $somecondition, MyObject => ( 'NO_USE' );
Or just simpler:
use MyObject qw( NO_USE );
Edit:
After a bit of fiddling with 'use' - there's a couple of gotchas, in that use if doesn't seem to like lexical variables. So you need to do something like:
#!/usr/bin/perl
package MyObject;
use strict;
use warnings;
our $import_stuff = 1;
sub import {
my ( $package, $msg ) = #_;
if ( $msg and $msg eq "NO_USE" ) {
$import_stuff = 0;
}
use if $import_stuff, 'Text::CSV';
}
1;
And call:
#!/usr/bin/perl
use strict;
use warnings;
use MyObject qw( NO_USE );
use Data::Dumper;
print Dumper \%INC;
my $test = Text::CSV -> new();
(Which errors if you set NO_USE and doesn't otherwise).
I think that's an artifact of use being a compile time directive still, so requires a (package scoped) condition.
I'd like to setup Config::General to read from the __DATA__ section of a script instead of an external file. (I realize that's not normally how it works, but I'd like to see if I can get it going. A specific use case is so I can send a script example to another developer without having to send a separate config file.)
According to the perldoc perldata, $main::DATA should act as a valid filehandle. I think Config::General should then be able to use -ConfigFile => \$FileHandle to read it, but it's not working for me. For example, this script will execute without crashing, but the __DATA__ isn't read in.
#!/usr/bin/perl -w
use strict;
use Config::General;
use YAML::XS;
my $configObj = new Config::General(-ConfigFile => $main::DATA);
my %config_hash = $configObj->getall;
print Dump \%config_hash;
__DATA__
testKey = testValue
I also tried:
my $configObj = new Config::General(-ConfigFile => \$main::DATA);
and
my $configObj = new Config::General(-ConfigFile => *main::DATA);
and a few other variations, but couldn't get anything to work.
Is it possible to use Config::General to read config key/values from __DATA__?
-ConfigFile requires a reference to a handle. This works:
my $configObj = Config::General->new(
-ConfigFile => \*main::DATA
);
The DATA handle is a glob, not a scalar.
Try *main::DATA instead of $main::DATA.
(and maybe try \*main::DATA. From the Config::General docs it looks like you are supposed to pass a filehandle argument as a reference.)
If the -ConfigGeneral => filehandle argument to the constructor doesn't do what you mean, an alternative is
new Config::General( -String => join ("", <main::DATA>) );
This works for me:
#!/usr/bin/perl
use strict;
use warnings;
use Config::General;
use YAML::XS;
my $string;
{
local $/;
$string = <main::DATA>;
};
my $configObj = new Config::General(-String => $string);
my %config_hash = $configObj->getall;
use Data::Dumper;
warn Dumper(\%config_hash);
__DATA__
testKey = testValue