Proc-ProcessTable

 view release on metacpan or  search on metacpan

ProcessTable.xs  view on Meta::CPAN

constant(name,arg)
	char *		name
	int		arg

SV*
table(obj)
     SV*  obj
     CODE:

     /* Check that we have an actual object. 
       calling Proc::Processtable->table SIGSEVs
       calling on an actual object is valid my $proc_obj = Proc::ProcessTable->new; $proc_obj->table; 
     */
     if (!obj || !SvOK (obj) || !SvROK (obj) || !sv_isobject (obj)) {
         croak("Must call table from an initalized object created with new");
     }


     HV* hash;
     SV** fetched;


     mutex_table(1);
     /* Cache a pointer to the tty device hash */ 
     Ttydevs = perl_get_hv("Proc::ProcessTable::TTYDEVS", FALSE);

     /* dereference our object to a hash */
     hash = (HV*) SvRV(obj);

     /* If the Table array already exists on our object we clear it
        and store a pointer to it in Proclist */
     if( hv_exists(hash, "Table", 5) ){
       /* fetch the hash entry */
       fetched = hv_fetch(hash, "Table", 5, 0);
       /* what's stored in the hash is a ref to the array, so we need
          to dereference it */
       Proclist = (AV*) SvRV(*fetched);
       av_clear(Proclist);
     }
     else{
       /* Otherwise we create the array and store it on the object. */
       Proclist = newAV();
       hv_store(hash, "Table", 5, newRV_noinc((SV*)Proclist), 0);
     }

     /* Call get_table to build the process objects and push them onto
        the Proclist */
     OS_get_table();

     /* Return a ref to our process list */
     RETVAL = newRV_inc((SV*) Proclist);

     mutex_table(0);
     
     OUTPUT:
     RETVAL

void
fields(obj)
     SV*  obj
     PPCODE:

     /* see above.  This should be called on an object generated by new */
     if (!obj || !SvOK (obj) || !SvROK (obj) || !sv_isobject (obj)) {
         croak("Must call fields from an initalized object created with new");
     }

     int i;
     SV* my_sv;

     if( Fields == NULL ){
       PUSHMARK(SP);
       XPUSHs(obj);
       PUTBACK;
       perl_call_method("table", G_DISCARD);
     }

     EXTEND(SP,Numfields);
     for (i=0; i < Numfields; i++ ){
       my_sv = newSVpv(Fields[i],0);
       PUSHs(sv_2mortal(my_sv));
     }

void 
_initialize_os(obj)
     SV*  obj
     CODE:
     char* error;

     if( (error = OS_initialize()) != NULL ){
       croak("%s", error);
     }



( run in 1.260 second using v1.01-cache-2.11-cpan-5511b514fd6 )