stas 2002/08/20 21:44:14
Modified: xs/APR/PerlIO apr_perlio.c
Log:
improve errors handling
add extended debugging trace
Revision Changes Path
1.21 +34 -11 modperl-2.0/xs/APR/PerlIO/apr_perlio.c
Index: apr_perlio.c
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/PerlIO/apr_perlio.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- apr_perlio.c 5 Jul 2002 05:05:36 -0000 1.20
+++ apr_perlio.c 21 Aug 2002 04:44:14 -0000 1.21
@@ -268,13 +268,20 @@
#ifdef PERLIO_APR_DEBUG
const char *new_path = NULL;
+ apr_os_file_t os_file;
+
if (!PL_dirty) {
/* if this is called during perl_destruct we are in trouble */
apr_file_name_get(&new_path, st->file);
}
- Perl_warn(aTHX_ "PerlIOAPR_close obj=0x%lx, file=0x%lx, name=%s\n",
- (unsigned long)f, (unsigned long)st->file,
+ rc = apr_os_file_get(&os_file, st->file);
+ if (rc != APR_SUCCESS) {
+ Perl_croak(aTHX_ "filedes retrieval failed!");
+ }
+
+ Perl_warn(aTHX_ "PerlIOAPR_close obj=0x%lx, file=0x%lx, fd=%d, name=%s\n",
+ (unsigned long)f, (unsigned long)st->file, os_file,
new_path ? new_path : "(UNKNOWN)");
#endif
@@ -415,9 +422,11 @@
{
char *mode;
const char *layers = ":APR";
+ PerlIOAPR *st;
PerlIO *f = PerlIO_allocate(aTHX);
+
if (!f) {
- return NULL;
+ Perl_croak(aTHX_ "Failed to allocate PerlIO struct");
}
switch (type) {
@@ -430,19 +439,33 @@
};
PerlIO_apply_layers(aTHX_ f, mode, layers);
+ if (!f) {
+ Perl_croak(aTHX_ "Failed to apply the ':APR' layer");
+ }
- if (f) {
- PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
+ st = PerlIOSelf(f, PerlIOAPR);
- /* XXX: should we dup first? the timeout could close the fh! */
- st->pool = pool;
- st->file = file;
- PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+#ifdef PERLIO_APR_DEBUG
+ {
+ apr_status_t rc;
+ apr_os_file_t os_file;
- return f;
+ /* convert to the OS representation of file */
+ rc = apr_os_file_get(&os_file, file);
+ if (rc != APR_SUCCESS) {
+ croak("filedes retrieval failed!");
+ }
+
+ Perl_warn(aTHX_ "converting to PerlIO fd %d, mode '%s'\n",
+ os_file, mode);
}
+#endif
+
+ st->pool = pool;
+ st->file = file;
+ PerlIOBase(f)->flags |= PERLIO_F_OPEN;
- return NULL;
+ return f;
}
static SV *apr_perlio_PerlIO_to_glob(pTHX_ PerlIO *pio, apr_perlio_hook_e type)