multiple codepages

C

C.DeRykus

I never get it why people test $@.

Reflex.

eval "*foo = \\$tmp; 1" or die $@;

And if you are going to die anyway:

*foo = \$tmp;
Click to expand...
^^^^^^^^^^^^^
No this is not the same... with or without an
eval in the mix.

The idea is to make $foo read-only outside
the sub so you'd need something more like:

eval "*foo = \\$tmp;";
 
R

Rainer Weikusat

[difference between lexically scoped our and my]
Yes, thanks I realize that. My point was although it was a loose
"encapsulation" you can come close to faking what 'state' and
'my-variables in a surrounding scope' can do.
Click to expand...

Well, nobody ever doubted that all this outlandish, newfangled stuff
like "lexically scoped objects" isn't really necessary since dynamically
scoped ('global') variables is really all that's needed To Get The Job
Done[tm], and someone who can't be bothered with exercising the
necessary care to do so has no business programming computer
anyway. This will also be much better for performance!

I'm sorry but I don't quite understand the purpose of this crusade. I'm
also not trying to convince anyone that he shouldn't "just use global
variables" whenever he considers that sensible, I was just trying
explain the difference between an object that's private to a subroutine
and an object owned by the containing package.
In fact, although it's nothing more than a curiosity,
(maybe "curioser and curioser" Alice would say) you could
even tighten it a bit more with an eval:

package MyFoo;
our( $foo, $tmp );
sub add_something {
local $tmp = $foo;
$tmp += $_[0];
*foo = eval "\\$tmp"; die $@ if $@ ;
return $foo;
}


Now an injection of $MyFoo::foo = -17 won't be possible.
Click to expand...

package MyFoo;
our( $foo, $tmp );
sub add_something {
local $tmp = $foo;
$tmp += $_[0];
*foo = eval "\\$tmp";
return $foo;
}

package SatanicLaughter;

use overload
'+' => sub {
my $self = $_[0];

print STDERR ("I'm the lord of inverse and bring you subtraction!\n");
return $$self -= $_[1];
};


sub new
{
my $self;

$self = $_[1];
return bless(\$self, $_[0]);
}

package FoosRUs;

print MyFoo::add_something(14), "\n";

my $x = SatanicLaughter->new($MyFoo::foo);
*MyFoo::foo = \$x;

print MyFoo::add_something(15), "\n";
 
C

C.DeRykus

.....

use Scalar::Util qw(blessed);
package MyFoo;
our( $foo, $tmp );
sub add_something {
Click to expand...

my $class = Scalar::Util::blessed( $foo );
die <<END if $class;
Regretfully, the church had to perform an unscheduled exorcism of a potentially satanic blessing. This church must insist all supplicants enter unblessed at this time. Thank you for your understanding and good will."
END
local $tmp = $foo;
$tmp += $_[0];
*foo = eval "\\$tmp";
return $foo;
}

package SatanicLaughter;
use overload

'+' => sub {
my $self = $_[0];

print STDERR ("I'm the lord of inverse and bring you subtraction!\n");

return $$self -= $_[1];
};

sub new
{
my $self;
$self = $_[1];
return bless(\$self, $_[0]);
}

package FoosRUs;

print MyFoo::add_something(14), "\n";
my $x = SatanicLaughter->new($MyFoo::foo);
*MyFoo::foo = \$x;

print MyFoo::add_something(15), "\n";
Click to expand...
 
R

Rainer Weikusat

C.DeRykus said:
....

use Scalar::Util qw(blessed);
package MyFoo;
our( $foo, $tmp );
sub add_something {
Click to expand...

my $class = Scalar::Util::blessed( $foo );
die <<END if $class;
Regretfully, the church had to perform an unscheduled exorcism of a potentially satanic blessing. This church must insist all supplicants enter unblessed at this time. Thank you for your understanding and good will."
END
local $tmp = $foo;
$tmp += $_[0];
*foo = eval "\\$tmp";
return $foo;
}
Click to expand...
Click to expand...

package FoosRUs;

print MyFoo::add_something(14), "\n";

my $x = SatanicLaughter->new($MyFoo::foo);
*MyFoo::foo = \$x;

my $blessed = \&Scalar::Util::blessed;
*Scalar::Util::blessed = sub($) {
if (caller() eq 'MyFoo') {
print STDERR <<TT;
The economy has been turned around in your area and the
IT system of the contractor who pockets the money for
providing what used to be this service doesn't (yet)
work as you might have come to expect.

Because this doesn't cost us anything, we apologize for
any inconvenience caused.

TT
return;
}

&$blessed;
};


print MyFoo::add_something(15), "\n";
 
C

C.DeRykus

....


package FoosRUs;



print MyFoo::add_something(14), "\n";



my $x = SatanicLaughter->new($MyFoo::foo);

*MyFoo::foo = \$x;

my $blessed = \&Scalar::Util::blessed;

*Scalar::Util::blessed = sub($) {

if (caller() eq 'MyFoo') {

print STDERR <<TT;

The economy has been turned around in your area and the

IT system of the contractor who pockets the money for

providing what used to be this service doesn't (yet)

work as you might have come to expect.
Because this doesn't cost us anything, we apologize for
any inconvenience caused.
TT
return;
&$blessed;
};
print MyFoo::add_something(15), "\n";
Click to expand...


package MyFoo;
our( $foo, $tmp);

sub add_something
{
die <<END if CORE::ref($foo);
*** Dear Supplicant:
Halleujah, there's been an exorcism of
potential satanic works. However, our
sanctuary remains in a state of siege.
Please ignore any screen output with
the mark of the beast. Any suggestions
to combat this ongoing threat will be
most gratefully received.
END
local $tmp = $foo;
$tmp += $_[0];
*foo = eval "\\$tmp";
return $foo;
}
 
R

Rainer Weikusat

[lots of 'codes' mutually breaking themselves]
package MyFoo;
our( $foo, $tmp);

sub add_something
{
die <<END if CORE::ref($foo);
*** Dear Supplicant:
Halleujah, there's been an exorcism of
potential satanic works. However, our
sanctuary remains in a state of siege.
Please ignore any screen output with
the mark of the beast. Any suggestions
to combat this ongoing threat will be
most gratefully received.
END
local $tmp = $foo;
$tmp += $_[0];
*foo = eval "\\$tmp";
return $foo;
}
Click to expand...

Insert

BEGIN {
*CORE::GLOBAL::die = sub {
print STDERR ("Lasciate ogne speranza, voi ch'intrate ...\n");
};
}

in front of the other code :). But there are trivial workarounds for
this as well.
 
R

Rainer Weikusat

Ben Morrow said:
require XSLoader;
XSLoader::load("List::Util", $List::Util::VERSION);

or, indeed, since List::Util is a well-behaved module,

delete $INC{"List/Util.pm"};
{
no warnings "redefine";
require List::Util;
}
Click to expand...

What purpose is List::Util supposed to have in here?
 
R

Rainer Weikusat

Ben Morrow said:
require XSLoader;
XSLoader::load("List::Util", $List::Util::VERSION);

or, indeed, since List::Util is a well-behaved module,

delete $INC{"List/Util.pm"};
{
no warnings "redefine";
require List::Util;
}
Click to expand...

What purpose is List::Util supposed to have in here?

Something I don't really dare to suggest: A reference to the real
Scalar::Util::blessed could be captured in some variable which is not
accessible from outside the subroutine and then be used to invoke said
'real blessed'.

BEGIN {
my $blessed;
require Scalar::Util;
$blessed = \&Scalar::Util::blessed;

sub noli_disturbare_circulus_meos
{
print STDERR ($blessed->($_[0]) ? 'Nowdays, nothing but thinking global is really sensible!'
: 'Pitful attempt to move technology forward beyond 1956. Will have to wait until the old guard has died' , "\n");
}
}

*Scalar::Util::blessed = sub { return 3; };

noli_disturbare_circulus_meos(bless([], 'bla'));
 
R

Rainer Weikusat

Ben Morrow said:
require XSLoader;
XSLoader::load("List::Util", $List::Util::VERSION);

or, indeed, since List::Util is a well-behaved module,

delete $INC{"List/Util.pm"};
{
no warnings "redefine";
require List::Util;
}
Click to expand...

What purpose is List::Util supposed to have in here?

Something I don't really dare to suggest: A reference to the real
Scalar::Util::blessed could be captured in some variable which is not
accessible from outside the subroutine and then be used to invoke said
'real blessed'.

BEGIN {
my $blessed;
require Scalar::Util;
$blessed = \&Scalar::Util::blessed;

sub noli_disturbare_circulus_meos
{
print STDERR ($blessed->($_[0]) ? 'Nowdays, nothing but thinking global is really sensible!'
: 'Pitful attempt to move technology forward beyond 1956. Will have to wait until the old guard has died' , "\n");
}
}

*Scalar::Util::blessed = sub { return; };

noli_disturbare_circulus_meos(bless([], 'bla'));
 
C

C.DeRykus

Quoth "C.DeRykus" <derykus@gmail.
...



require XSLoader;

XSLoader::load("List::Util", $List::Util::VERSION);

or, indeed, since List::Util is a well-behaved module,


delete $INC{"List/Util.pm"};

{
no warnings "redefine";

require List::Util;
}
Click to expand...

Indeed. Once Scalar-List-Utils was installed,
this sufficed (with both deletes needed,
combined shareable lib responsible, I guess ).


package MyFoo;
our( $foo, $tmp);
sub add_something {
delete $INC{"Scalar/Util.pm"};
delete $INC{"List/Util.pm"};
require Scalar::Util;
my $class = Scalar::Util::blessed( $foo);
die <<END if $class;
...
END
local $tmp = $foo;
$tmp += $_[0];
*foo = eval "\\$tmp";
return $foo;
}
 
R

Rainer Weikusat

Ben Morrow said:
Quoth Rainer Weikusat said:
Ben Morrow said:
Quoth "C.DeRykus" <[email protected]>:
On Monday, October 14, 2013 3:47:09 AM UTC-7, Rainer Weikusat wrote:

my $blessed = \&Scalar::Util::blessed;
*Scalar::Util::blessed = sub($) { [...]
require XSLoader;
XSLoader::load("List::Util", $List::Util::VERSION);
Click to expand...
[...]

What purpose is List::Util supposed to have in here?
Click to expand...

Try it and see :). (Hint: Scalar::Util and List::Util are both part of
the Scalar-List-Utils CPAN distribution, which only installs one .so
file.)

Of course, for real paranoia this could be augmented with something like

use Variable::Magic qw/cast wizard/;

my $blessed = \&Scalar::Util::blessed;
cast *Scalar::Util::blessed, wizard set => sub {
*{$_[0]} = $blessed;
warn <<HOLIERTHANTHOU;
*** Warning: a devilish attempt to subvert the sanctity of the
sacrament has been detected. This attempt has been thwarted.
HOLIERTHANTHOU
};

though even that won't do you any good in the long run...
Click to expand...

As soon as this moves into the domain of using custom extensions written
in C, the quest(ion) becomes a little useless: Provided that arbitrary
modifications can be made to the memory of the process, any concept of
'Perl semantics' evaporates.

Actually, I already consider the 'reload a file from the filesystem'
trick something similiar,

----------
package FoosRUs;

MyFoo::add_something(9);

*blessed = \&Scalar::Util::blessed;

mkdir('/tmp/Scalar');
open($fh, '>', '/tmp/Scalar/Util.pm');
print $fh <<'TT';
package Scalar::Util;

sub blessed($) {
caller() eq 'MyFoo' && do {
print STDERR <<XX;
Consider Phlebas, the Phoenician, a fortnight dead
Who once was handsome and tall just like you ...
XX
return;
};

goto &FoosRUs::blessed;
}

1;
TT

close($fh);
unshift(@INC, '/tmp');

my $x = SomethingElse->new($MyFoo::foo);
*MyFoo::foo = \$x;

print MyFoo::add_something(666), "\n";
----------

[quoted from memory and likely somewhat wrong]

but that's not really about what can or can't be done with Perl/perl
anymore.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Converting codepages to UTF8 16
Batch Convert HTML to UTF-8 Files 2
Filter table rows based on multiple checkboxes value 2
Using ctypes with Windows API to get FileVersion of a file 0
Reading Windows CSV file with LCID entries under Linux. 2
Help with importing from multiple files and printing lines in designated spot to spit out one file. 1
Problem with a login script, SESSION user rights and put this together so it works with the other pages and MySQL. Code examples. 2
I have to finish this code for my assignment but I cant figure out how to solve it 1

Members online

Total: 29 (members: 1, guests: 28)
Robots: 181

Forum statistics

Threads
473,756
Messages
2,569,540
Members
45,025
Latest member
KetoRushACVFitness

Latest Threads

Top