stas 01/12/04 21:31:09
Modified: lib/Apache compat.pm
t/apache compat.t
t/response/TestApache compat.pm
Log:
- the implementation of compatibility layer for Apache::File from 1.x
- tests
Revision Changes Path
1.25 +63 -0 modperl-2.0/lib/Apache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- compat.pm 2001/11/19 23:33:21 1.24
+++ compat.pm 2001/12/05 05:31:09 1.25
@@ -263,5 +263,68 @@
$r->send_fd_length($fh, -1);
}
+package Apache::File;
+
+use Fcntl ();
+use Symbol ();
+
+sub new {
+ my($class) = shift;
+ my $fh = Symbol::gensym;
+ my $self = bless $fh, ref($class)||$class;
+ if (@_) {
+ return $self->open(@_) ? $self : undef;
+ }
+ else {
+ return $self;
+ }
+}
+
+sub open {
+ my($self) = shift;
+ open $self, shift, @_; # because of open's prototype
+}
+
+sub close {
+ my($self) = shift;
+ close $self;
+}
+
+
+my $TMPNAM = 'aaaaaa';
+my $TMPDIR = $ENV{'TMPDIR'} || $ENV{'TEMP'} || '/tmp';
+($TMPDIR) = $TMPDIR =~ /^([^<>|;*]+)$/; #untaint
+my $Mode = Fcntl::O_RDWR()|Fcntl::O_EXCL()|Fcntl::O_CREAT();
+my $Perms = 0600;
+
+sub tmpfile {
+ my $class = shift;
+ my $limit = 100;
+ my $r = Apache->request;
+ while ($limit--) {
+ my $tmpfile = "$TMPDIR/${$}" . $TMPNAM++;
+ my $fh = $class->new;
+ sysopen($fh, $tmpfile, $Mode, $Perms);
+ $r->register_cleanup(sub { unlink $tmpfile }) if $r;
+ if ($fh) {
+ return wantarray ? ($tmpfile, $fh) : $fh;
+ }
+ }
+}
+
+# the following functions now live in Apache::Response
+use Apache::Response;
+# * discard_request_body
+# * meets_conditions
+# * set_content_length
+# * set_etag
+# * set_last_modified
+# * update_mtime
+
+# the following functions now live in Apache::RequestRec
+use Apache::RequestRec;
+# * mtime
+
+
1;
__END__
1.4 +23 -1 modperl-2.0/t/apache/compat.t
Index: compat.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/apache/compat.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- compat.t 2001/10/01 09:04:11 1.3
+++ compat.t 2001/12/05 05:31:09 1.4
@@ -6,7 +6,7 @@
use Apache::TestUtil;
use Apache::TestRequest;
-plan tests => 11, \&have_lwp;
+plan tests => 20, \&have_lwp;
my $location = "/TestApache::compat";
@@ -52,6 +52,12 @@
t_header('out','set', q{$r->header_out($key => $val)});
t_header('out','unset', q{$r->header_out($key => undef)});
+# Apache::File
+{
+ my @data = (test => 'file');
+ my $data = GET_BODY query(@data) || '';
+ ok_nok($data);
+}
### helper subs ###
@@ -67,5 +73,21 @@
GET_BODY(query(test => 'header', way => $way, what => $what)),
$comment
);
+}
+
+# accepts multiline var where, the lines matching:
+# ^ok\n$ results in ok(1)
+# ^nok\n$ results in ok(0)
+# the rest is printed as is
+sub ok_nok {
+ for (split /\n/, shift) {
+ if (/^ok\n?$/) {
+ ok 1;
+ } elsif (/^nok\n?$/) {
+ ok 0;
+ } else {
+ print "$_\n";
+ }
+ }
}
1.3 +61 -2 modperl-2.0/t/response/TestApache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestApache/compat.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- compat.pm 2001/09/29 19:33:39 1.2
+++ compat.pm 2001/12/05 05:31:09 1.3
@@ -3,16 +3,23 @@
use strict;
use warnings FATAL => 'all';
-use Apache::compat ();
-
use Apache::TestUtil;
+use Apache::Test ();
+
+use Apache::compat ();
use Apache::Constants qw(OK M_POST DECLINED);
+use subs qw(ok debug);
+my $gr;
+
sub handler {
my $r = shift;
$r->send_http_header('text/plain');
+ my $cfg = Apache::Test::config();
+ my $vars = $cfg->{vars};
+
my %data;
if ($r->method_number == M_POST) {
%data = $r->content;
@@ -70,8 +77,60 @@
$r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
}
}
+ elsif ($data{test} eq 'file') {
+ $gr = $r;
+ my $file = $vars->{t_conf_file};
+
+ debug "new Apache::File file object";
+ ok my $fh = Apache::File->new;
+
+ debug "open itself";
+ if ($fh->open($file)) {
+ ok 1;
+ debug "read from file";
+ my $read = <$fh>;
+ ok $read;
+ debug "close file";
+ ok $fh->close;
+ }
+ else {
+ ok 0;
+ debug "ok: cannot read from the closed fh";
+ ok 1;
+ debug "ok: close file should fail, wasn't opened";
+ ok !$fh->close;
+ }
+
+ debug "open non-exists";
+ ok !$fh->open("$file.nochance");
+ debug "new+open";
+ if (my $fh = Apache::File->new($file)) {
+ ok 1;
+ $fh->close;
+ }
+ else {
+ ok 0;
+ }
+
+ debug "new+open non-exists";
+ ok !Apache::File->new("$file.yeahright");
+
+ debug "open tmpfile";
+ ok my ($tmpfile, $tmpfh) = Apache::File->tmpfile;
+
+ debug "write/read from tmpfile";
+ my $write = "test $$";
+ print $tmpfh $write;
+ seek $tmpfh, 0, 0;
+ my $read = <$tmpfh>;
+ ok $read eq $write;
+ }
+
OK;
}
+
+sub ok { $gr->print($_[0] ? "ok\n" : "nok\n"); }
+sub debug { $gr->print("# $_\n") for @_; }
1;
