cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c

[st...@apache.org]

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)