J
John W. Krahn
Helmut said:
Why are you using -e? You have a race condition.
sub get_foo { my $fh; open $fh, '<', '/etc/foo.conf' and return scalar
<$fh> }
John
Why are you using -e? You have a race condition.
sub get_foo { my $fh; open $fh, '<', '/etc/foo.conf' and return scalar
<$fh> }
John
H
Helmut Wollmersdorfer
Hi,
to test a module like this
package MyModule;
sub get_foo {
my $file = '/etc/foo.conf';
if (-e $file) {
open my $fh,'<',$file;
my $content = <$fh>;
return $content;
}
}
I tried to mock '-e'
=== get_foo.t ===
#!perl -T
use strict;
use warnings;
my %file;
use overload
'-e' => sub {
my ($name) = @_;
print 'trying mocked -e',"\n";
return exists $file{$name};
};
use Test::More qw(no_plan);
$file{foo} = 1;
ok(-e 'foo', 'file foo exists'); # does not work
__END__
The above does not overwrite the behaviour of -e.
How can I do it?
TIA
Helmut Wollmersdorfer
to test a module like this
package MyModule;
sub get_foo {
my $file = '/etc/foo.conf';
if (-e $file) {
open my $fh,'<',$file;
my $content = <$fh>;
return $content;
}
}
I tried to mock '-e'
=== get_foo.t ===
#!perl -T
use strict;
use warnings;
my %file;
use overload
'-e' => sub {
my ($name) = @_;
print 'trying mocked -e',"\n";
return exists $file{$name};
};
use Test::More qw(no_plan);
$file{foo} = 1;
ok(-e 'foo', 'file foo exists'); # does not work
__END__
The above does not overwrite the behaviour of -e.
How can I do it?
TIA
Helmut Wollmersdorfer
I
Ilya Zakharevich
[A complimentary Cc of this posting was sent to
John W. Krahn
This leaves no way for the caller to check for errors.
sub get_foo { my $fh; open $fh, '<', '/etc/foo.conf' or return; scalar <$fh> }
Note the differences,
Ilya
John W. Krahn
This leaves no way for the caller to check for errors.
sub get_foo { my $fh; open $fh, '<', '/etc/foo.conf' or return; scalar <$fh> }
Note the differences,
Ilya
H
helmut.wollmersdorfer.ext
It is not my code. I only want to test the module without change of
the source.
My question is how to mock or overwrite '-e', or more general '-X', or
overwrite the function behind the operator '-e'.
Helmut Wollmersdorfer
M
Michele Dondi
Appears to work:
C:\temp>cat foo.pl
#!/usr/bin/perl
use strict;
use warnings;
my %file;
BEGIN {
no strict 'refs';
*{'CORE::GLOBAL::-e'} = sub {
my ($name) = @_;
warn "trying mocked -e\n";
return exists $file{$name};
};
}
use Test::More qw(no_plan);
$file{foo} = 1;
ok(-e $_, "file $_ exists") for qw/foo bar/;
__END__
C:\temp>perl foo.pl
ok 1 - file foo exists
not ok 2 - file bar exists
# Failed test 'file bar exists'
# at foo.pl line 20.
1..2
# Looks like you failed 1 test of 2.
HTH,
Michele
H
Helmut Wollmersdorfer
Michele said:
Hmmm ... where is the output of 'warn "trying mocked -e\n";'?
Maybe you have 'foo' in your filesystem?
That's what I get (tested under Perl 5.8.8 and 5.10.0):
helmut@duo2400:~$ ls foo*
ls: cannot access foo*: No such file or directory
helmut@duo2400:~$ perl mock_e.t
not ok 1 - file foo exists
# Failed test 'file foo exists'
# at mock_e.t line 20.
not ok 2 - file bar exists
# Failed test 'file bar exists'
# at mock_e.t line 20.
1..2
# Looks like you failed 2 tests of 2.
Helmut Wollmersdorfer
M
Michele Dondi
Yep, I believe you're right. That's what you get out of posting when
your eyes just can hardly stay open! [End of *standard* disclaimer...]
Actually, now that I think of it, I don't know if -X functions are
overridable, and you made me discover something interesting: people
generally check the prototype() of CORE:: functions because IF they
are not ovverridable THEN it returns undef() - but then please note
that the inverse implication does not hold[*]. Now, I tried to see
what happens with -e() and it turns out that it gives a run-time error
I had *never* seen:
whisky:~ [09:58:08]$ perl -E 'say prototype "CORE::$_" // "undef"
;$
undef
Can't find an opnumber for "-e" at -e line 2.
Anyway, as they say, the proof of the pudding is in the eating: the
above in fact would imply that -X functions are *not* overridable.
As far as your problem is concerned, I thought that perhaps -X's would
use stat() behind the courtain and that you may override the latter,
(at the expense of some flexibility,) which is doable. But that's not
the case:
whisky:~/test [10:38:06]$ ls
foo.pl
whisky:~/test [10:38:09]$ cat foo.pl
#!/usr/bin/perl
use strict;
use warnings;
my %file;
BEGIN {
no strict 'refs';
*{'CORE::GLOBAL::stat'} = sub {
warn "trying mocked stat()\n";
(my $f)=@_;
CORE::stat( @_ && !ref($f) &&
exists $file{$f} ? $0 : @_ );
};
}
use Test::More qw(no_plan);
$file{foo} = 1;
ok( (scalar stat $_) => "file $_ exists") for qw/foo bar/;
ok( (-e $_) => "file $_ exists") for qw/foo bar/;
__END__
whisky:~/test [10:38:13]$ ./foo.pl
trying mocked stat()
ok 1 - file foo exists
trying mocked stat()
not ok 2 - file bar exists
# Failed test 'file bar exists'
# at ./foo.pl line 21.
not ok 3 - file foo exists
# Failed test 'file foo exists'
# at ./foo.pl line 22.
not ok 4 - file bar exists
# Failed test 'file bar exists'
# at ./foo.pl line 22.
1..4
# Looks like you failed 3 tests of 4.
[*] E.g. require() returns undef() but I have *seen* it duly
overridden.
Michele
M
Michele Dondi
BTW: I brought this up in PerlMonks. Incidentally, there someone
pointed me to <http://perlmonks.org/?node_id=584078> and in particular
to the *second footnote* which may be interesting for the OP: it seems
that definitely filetest operators are not overridable in any way, and
that a patch was submitted to p5p to enable that instead. But it was
refused. Still, the node is not very recent... In the meanwhile,
somebody made me notice (see <http://perlmonks.org/?node_id=720682>,)
that qw// is now overridable.
Michele
I
Ilya Zakharevich
[A complimentary Cc of this posting was NOT [per weedlist] sent to
Michele Dondi
.... And where is [*]?
When I (first) implemented prototype on CORE::***, I used an existing
table in the lexer, and just translated the semantic of this table to
the semantic of prototype(). I did only a very quick scan through the
table to check the validity. The lexer has too many special cases
which massaged the argument before access to the table, and I could
miss some...
This is what I would like to change if I ever work on Perl again: it
must have a concept of IFS in the core...
You managed to give me several very deep breaths... You meant qx()
here, right?
Yours,
Ilya
Michele Dondi
.... And where is [*]?
When I (first) implemented prototype on CORE::***, I used an existing
table in the lexer, and just translated the semantic of this table to
the semantic of prototype(). I did only a very quick scan through the
table to check the validity. The lexer has too many special cases
which massaged the argument before access to the table, and I could
miss some...
This is what I would like to change if I ever work on Perl again: it
must have a concept of IFS in the core...
You managed to give me several very deep breaths... You meant qx()
here, right?
Yours,
Ilya
M
Michele Dondi
It was in the twice quoted message. Pasted hereafter:
: [*] E.g. require() returns undef() but I have *seen* it duly
: overridden.
And... What is IFS supposed to mean?
Oops! Well, of course. Apologies for the "several very deep breaths,"
or... was it a *positive* experience, perhaps?
Michele
J
John W. Krahn
Michele said:
Input Field Separator
John
I
Ilya Zakharevich
[A complimentary Cc of this posting was NOT [per weedlist] sent to
Michele Dondi
Something like
my $fs = Installible::FileSystem::FTP->new('ftp://ftp/perl.org/CPAN');
chdir $fs;
# After this all filesystem operators are redirected as method calls
# on $fs
So you can use File::Find to traverse FTP directories, etc.
Hope this helps,
Ilya
Michele Dondi
Something like
my $fs = Installible::FileSystem::FTP->new('ftp://ftp/perl.org/CPAN');
chdir $fs;
# After this all filesystem operators are redirected as method calls
# on $fs
So you can use File::Find to traverse FTP directories, etc.
Hope this helps,
Ilya