All functionality of the RPM::Error class moved from RPM.xs to RPM/Error.xs
CVS patchset: 4003 CVS date: 2000/08/02 08:45:16
This commit is contained in:
rjray
parent
bc3ea50dd5
commit
ff104c5328
|
|
@ -5,6 +5,7 @@ use ExtUtils::MakeMaker;
|
|||
RPM.xs RPM.c
|
||||
RPM/Constants.xs RPM/Constants.c
|
||||
RPM/Database.xs RPM/Database.c
|
||||
RPM/Error.xs RPM/Error.c
|
||||
RPM/Header.xs RPM/Header.c
|
||||
);
|
||||
|
||||
|
|
|
|||
|
|
@ -9,8 +9,8 @@ require DynaLoader;
|
|||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter DynaLoader);
|
||||
$VERSION = '0.26';
|
||||
$revision = do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
|
||||
$VERSION = '0.27';
|
||||
$revision = do { my @r=(q$Revision: 1.7 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
|
||||
|
||||
@EXPORT = qw(rpm_osname rpm_archname);
|
||||
@EXPORT_OK = @EXPORT;
|
||||
|
|
@ -21,6 +21,7 @@ bootstrap RPM $VERSION;
|
|||
bootstrap_Constants($VERSION);
|
||||
bootstrap_Header($VERSION);
|
||||
bootstrap_Database($VERSION);
|
||||
bootstrap_Error($VERSION);
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -30,14 +31,13 @@ __END__
|
|||
|
||||
RPM - Perl interface to the API for the RPM Package Manager
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use RPM;
|
||||
|
||||
$pkg = new RPM "file.arch.rpm";
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The B<Perl-RPM> package is an extension for natively linking the
|
||||
functionality of the B<RPM Package Manager> with the extension facility of
|
||||
Perl. The aim is to offer all the functionality made available via the C
|
||||
API in the form of Perl object classes.
|
||||
|
||||
At present, the package-manipulation functionality is not yet implemented.
|
||||
The B<RPM::Database> and B<RPM::Header> packages do provide access to the
|
||||
information contained within the database of installed packages, and
|
||||
|
|
|
|||
137
Perl-RPM/RPM.xs
137
Perl-RPM/RPM.xs
|
|
@ -4,20 +4,15 @@
|
|||
|
||||
#include "RPM.h"
|
||||
|
||||
static char * const rcsid = "$Id: RPM.xs,v 1.5 2000/06/11 11:23:26 rjray Exp $";
|
||||
static char * const rcsid = "$Id: RPM.xs,v 1.6 2000/08/02 08:45:16 rjray Exp $";
|
||||
|
||||
extern XS(boot_RPM__Constants);
|
||||
extern XS(boot_RPM__Header);
|
||||
extern XS(boot_RPM__Database);
|
||||
extern XS(boot_RPM__Error);
|
||||
|
||||
static HV* tag2num_priv;
|
||||
static HV* num2tag_priv;
|
||||
static CV* err_callback;
|
||||
|
||||
/*
|
||||
This was static, but it needs to be accessible from other modules, as well.
|
||||
*/
|
||||
SV* rpm_errSV;
|
||||
|
||||
static void setup_tag_mappings(pTHX)
|
||||
{
|
||||
|
|
@ -92,130 +87,6 @@ char* rpm_rpm_archname(void)
|
|||
return arch_name;
|
||||
}
|
||||
|
||||
/*
|
||||
This is a callback routine that the bootstrapper will register with the RPM
|
||||
lib so as to catch any errors. (I hope)
|
||||
*/
|
||||
static void rpm_catch_errors(void)
|
||||
{
|
||||
/* Because rpmErrorSetCallback expects (void)fn(void), we have to declare
|
||||
our thread context here */
|
||||
dTHX;
|
||||
int error_code;
|
||||
char* error_string;
|
||||
|
||||
error_code = rpmErrorCode();
|
||||
error_string = rpmErrorString();
|
||||
|
||||
/* Set the string part, first */
|
||||
sv_setsv(rpm_errSV, newSVpv(error_string, strlen(error_string)));
|
||||
/* Set the IV part */
|
||||
sv_setiv(rpm_errSV, error_code);
|
||||
/* Doing that didn't erase the PV part, but it cleared the flag: */
|
||||
SvPOK_on(rpm_errSV);
|
||||
|
||||
/* If there is a current callback, invoke it: */
|
||||
if (err_callback != NULL)
|
||||
{
|
||||
/* This is just standard boilerplate for calling perl from C */
|
||||
dSP;
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
PUSHMARK(sp);
|
||||
XPUSHs(sv_2mortal(newSViv(error_code)));
|
||||
XPUSHs(sv_2mortal(newSVpv(error_string, strlen(error_string))));
|
||||
PUTBACK;
|
||||
|
||||
/* The actual call */
|
||||
perl_call_sv((SV *)err_callback, G_DISCARD);
|
||||
|
||||
/* More boilerplate */
|
||||
SPAGAIN;
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
/* This is just to offer an easy way to clear both sides of $RPM::err */
|
||||
void clear_errors(pTHX)
|
||||
{
|
||||
sv_setsv(rpm_errSV, newSVpv("", 0));
|
||||
sv_setiv(rpm_errSV, 0);
|
||||
SvPOK_on(rpm_errSV);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
SV* set_error_callback(pTHX_ SV* newcb)
|
||||
{
|
||||
SV* oldcb;
|
||||
|
||||
oldcb = (err_callback) ? newRV((SV *)err_callback) : newSVsv(&PL_sv_undef);
|
||||
|
||||
if (SvROK(newcb)) newcb = SvRV(newcb);
|
||||
if (SvTYPE(newcb) == SVt_PVCV)
|
||||
err_callback = (CV *)newcb;
|
||||
else if (SvPOK(newcb))
|
||||
{
|
||||
char* fn_name;
|
||||
char* sv_name;
|
||||
|
||||
sv_name = SvPV(newcb, PL_na);
|
||||
if (! strstr(sv_name, "::"))
|
||||
{
|
||||
Newz(TRUE, fn_name, strlen(sv_name) + 7, char);
|
||||
strncat(fn_name, "main::", 6);
|
||||
strcat(fn_name + 6, sv_name);
|
||||
}
|
||||
else
|
||||
fn_name = sv_name;
|
||||
|
||||
err_callback = perl_get_cv(fn_name, FALSE);
|
||||
}
|
||||
else
|
||||
{
|
||||
err_callback = Null(CV *);
|
||||
}
|
||||
|
||||
return oldcb;
|
||||
}
|
||||
|
||||
void rpm_error(pTHX_ int code, const char* message)
|
||||
{
|
||||
rpmError(code, (char *)message);
|
||||
}
|
||||
|
||||
|
||||
MODULE = RPM PACKAGE = RPM::Error
|
||||
|
||||
|
||||
SV*
|
||||
set_error_callback(newcb)
|
||||
SV* newcb;
|
||||
PROTOTYPE: $
|
||||
CODE:
|
||||
RETVAL = set_error_callback(aTHX_ newcb);
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
void
|
||||
clear_errors()
|
||||
PROTOTYPE:
|
||||
CODE:
|
||||
clear_errors(aTHX);
|
||||
|
||||
void
|
||||
rpm_error(code, message)
|
||||
int code;
|
||||
char* message;
|
||||
PROTOTYPE: $$
|
||||
CODE:
|
||||
rpm_error(aTHX_ code, message);
|
||||
|
||||
|
||||
MODULE = RPM PACKAGE = RPM PREFIX = rpm_
|
||||
|
||||
|
||||
|
|
@ -232,7 +103,6 @@ BOOT:
|
|||
{
|
||||
SV * config_loaded;
|
||||
|
||||
rpm_errSV = perl_get_sv("RPM::err", GV_ADD|GV_ADDMULTI);
|
||||
config_loaded = perl_get_sv("RPM::__config_loaded", GV_ADD|GV_ADDMULTI);
|
||||
if (! (SvOK(config_loaded) && SvTRUE(config_loaded)))
|
||||
{
|
||||
|
|
@ -241,10 +111,9 @@ BOOT:
|
|||
}
|
||||
|
||||
setup_tag_mappings(aTHX);
|
||||
rpmErrorSetCallback(rpm_catch_errors);
|
||||
err_callback = Nullcv;
|
||||
|
||||
newXS("RPM::bootstrap_Constants", boot_RPM__Constants, file);
|
||||
newXS("RPM::bootstrap_Header", boot_RPM__Header, file);
|
||||
newXS("RPM::bootstrap_Database", boot_RPM__Database, file);
|
||||
newXS("RPM::bootstrap_Error", boot_RPM__Error, file);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
#
|
||||
###############################################################################
|
||||
#
|
||||
# $Id: Error.pm,v 1.2 2000/05/30 01:03:13 rjray Exp $
|
||||
# $Id: Error.pm,v 1.3 2000/08/02 08:45:16 rjray Exp $
|
||||
#
|
||||
# Description: Error-management support that cooperates with the primary
|
||||
# Perl/C error glue.
|
||||
|
|
@ -33,8 +33,8 @@ require RPM;
|
|||
|
||||
@ISA = qw(Exporter);
|
||||
|
||||
$VERSION = $RPM::VERSION;
|
||||
$revision = do { my @r=(q$Revision: 1.2 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
|
||||
$VERSION = '0.27';
|
||||
$revision = do { my @r=(q$Revision: 1.3 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
|
||||
|
||||
@EXPORT = qw(clear_errors set_error_callback rpm_error);
|
||||
@EXPORT_OK = @EXPORT;
|
||||
|
|
@ -100,6 +100,10 @@ raised as the error. Note that the callback may be invoked by internal error
|
|||
flagging in the core B<rpm> library, as well as by calls to B<rpm_error>
|
||||
above.
|
||||
|
||||
Before any user-provided callback is invoked, the C<$RPM::err> variable is
|
||||
set. While accessing it in a callback would be redundant, users should not
|
||||
be concerned about interrupting other internal processes (in theory, that is).
|
||||
|
||||
=back
|
||||
|
||||
=head1 DIAGNOSTICS
|
||||
|
|
|
|||
|
|
@ -0,0 +1,145 @@
|
|||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
|
||||
#include "RPM.h"
|
||||
|
||||
static char * const rcsid = "$Id: Error.xs,v 1.1 2000/08/02 08:45:16 rjray Exp $";
|
||||
|
||||
static CV* err_callback;
|
||||
|
||||
/*
|
||||
This was static, but it needs to be accessible from other modules, as well.
|
||||
*/
|
||||
SV* rpm_errSV;
|
||||
|
||||
/*
|
||||
This is a callback routine that the bootstrapper will register with the RPM
|
||||
lib so as to catch any errors. (I hope)
|
||||
*/
|
||||
static void rpm_catch_errors(void)
|
||||
{
|
||||
/* Because rpmErrorSetCallback expects (void)fn(void), we have to declare
|
||||
our thread context here */
|
||||
dTHX;
|
||||
int error_code;
|
||||
char* error_string;
|
||||
|
||||
error_code = rpmErrorCode();
|
||||
error_string = rpmErrorString();
|
||||
|
||||
/* Set the string part, first */
|
||||
sv_setsv(rpm_errSV, newSVpv(error_string, strlen(error_string)));
|
||||
/* Set the IV part */
|
||||
sv_setiv(rpm_errSV, error_code);
|
||||
/* Doing that didn't erase the PV part, but it cleared the flag: */
|
||||
SvPOK_on(rpm_errSV);
|
||||
|
||||
/* If there is a current callback, invoke it: */
|
||||
if (err_callback != NULL)
|
||||
{
|
||||
/* This is just standard boilerplate for calling perl from C */
|
||||
dSP;
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
PUSHMARK(sp);
|
||||
XPUSHs(sv_2mortal(newSViv(error_code)));
|
||||
XPUSHs(sv_2mortal(newSVpv(error_string, strlen(error_string))));
|
||||
PUTBACK;
|
||||
|
||||
/* The actual call */
|
||||
perl_call_sv((SV *)err_callback, G_DISCARD);
|
||||
|
||||
/* More boilerplate */
|
||||
SPAGAIN;
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
/* This is just to offer an easy way to clear both sides of $RPM::err */
|
||||
void clear_errors(pTHX)
|
||||
{
|
||||
sv_setsv(rpm_errSV, newSVpv("", 0));
|
||||
sv_setiv(rpm_errSV, 0);
|
||||
SvPOK_on(rpm_errSV);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
SV* set_error_callback(pTHX_ SV* newcb)
|
||||
{
|
||||
SV* oldcb;
|
||||
|
||||
oldcb = (err_callback) ? newRV((SV *)err_callback) : newSVsv(&PL_sv_undef);
|
||||
|
||||
if (SvROK(newcb)) newcb = SvRV(newcb);
|
||||
if (SvTYPE(newcb) == SVt_PVCV)
|
||||
err_callback = (CV *)newcb;
|
||||
else if (SvPOK(newcb))
|
||||
{
|
||||
char* fn_name;
|
||||
char* sv_name;
|
||||
|
||||
sv_name = SvPV(newcb, PL_na);
|
||||
if (! strstr(sv_name, "::"))
|
||||
{
|
||||
Newz(TRUE, fn_name, strlen(sv_name) + 7, char);
|
||||
strncat(fn_name, "main::", 6);
|
||||
strcat(fn_name + 6, sv_name);
|
||||
}
|
||||
else
|
||||
fn_name = sv_name;
|
||||
|
||||
err_callback = perl_get_cv(fn_name, FALSE);
|
||||
}
|
||||
else
|
||||
{
|
||||
err_callback = Null(CV *);
|
||||
}
|
||||
|
||||
return oldcb;
|
||||
}
|
||||
|
||||
void rpm_error(pTHX_ int code, const char* message)
|
||||
{
|
||||
rpmError(code, (char *)message);
|
||||
}
|
||||
|
||||
|
||||
MODULE = RPM::Error PACKAGE = RPM::Error
|
||||
|
||||
|
||||
SV*
|
||||
set_error_callback(newcb)
|
||||
SV* newcb;
|
||||
PROTOTYPE: $
|
||||
CODE:
|
||||
RETVAL = set_error_callback(aTHX_ newcb);
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
void
|
||||
clear_errors()
|
||||
PROTOTYPE:
|
||||
CODE:
|
||||
clear_errors(aTHX);
|
||||
|
||||
void
|
||||
rpm_error(code, message)
|
||||
int code;
|
||||
char* message;
|
||||
PROTOTYPE: $$
|
||||
CODE:
|
||||
rpm_error(aTHX_ code, message);
|
||||
|
||||
|
||||
BOOT:
|
||||
{
|
||||
rpm_errSV = perl_get_sv("RPM::err", GV_ADD|GV_ADDMULTI);
|
||||
rpmErrorSetCallback(rpm_catch_errors);
|
||||
err_callback = Nullcv;
|
||||
}
|
||||
Loading…
Reference in New Issue