diff options
Diffstat (limited to 'Perl-RPM')
-rw-r--r-- | Perl-RPM/ChangeLog | 6 | ||||
-rw-r--r-- | Perl-RPM/MANIFEST | 32 | ||||
-rw-r--r-- | Perl-RPM/README | 7 | ||||
-rw-r--r-- | Perl-RPM/RPM.h | 36 | ||||
-rw-r--r-- | Perl-RPM/RPM.pm | 8 | ||||
-rw-r--r-- | Perl-RPM/RPM.xs | 42 | ||||
-rw-r--r-- | Perl-RPM/RPM/Constants.xs | 3 | ||||
-rw-r--r-- | Perl-RPM/RPM/Database.pm | 16 | ||||
-rw-r--r-- | Perl-RPM/RPM/Database.xs | 76 | ||||
-rw-r--r-- | Perl-RPM/RPM/Error.pm | 9 | ||||
-rw-r--r-- | Perl-RPM/RPM/Header.xs | 167 | ||||
-rwxr-xr-x | Perl-RPM/t/01_database.t | 4 | ||||
-rwxr-xr-x | Perl-RPM/t/03_errors.t | 14 | ||||
-rwxr-xr-x | Perl-RPM/t/04_utils.t | 4 | ||||
-rw-r--r-- | Perl-RPM/typemap | 1 |
15 files changed, 219 insertions, 206 deletions
diff --git a/Perl-RPM/ChangeLog b/Perl-RPM/ChangeLog index 4ed5cb576..636cf0fe0 100644 --- a/Perl-RPM/ChangeLog +++ b/Perl-RPM/ChangeLog @@ -13,7 +13,7 @@ Revision history for Perl extension RPM. RPM namespace is present, but doesn't yet do anything useful. Some basic test scripts are in place, but more are (always) needed. -0.2 +0.2 Mon May 29 17:59:20 PDT 2000 - second alpha Class for RPM::Error added. The code is in the RPM.xs file, but @@ -32,3 +32,7 @@ Revision history for Perl extension RPM. Added two utility functions under the RPM::* space for getting O/S and architecture names. + + Put in the start of thread-safing the module. But this part of the + API is still pretty black in the Lockheed Skunkworks sense of the + word, so it isn't at all complete. diff --git a/Perl-RPM/MANIFEST b/Perl-RPM/MANIFEST index c05175975..d66422692 100644 --- a/Perl-RPM/MANIFEST +++ b/Perl-RPM/MANIFEST @@ -1,19 +1,19 @@ -ChangeLog -MANIFEST -Makefile.PL -README -RPM.h -RPM.pm -RPM.xs -RPM/Constants.pm -RPM/Constants.xs -RPM/Database.pm -RPM/Database.xs -RPM/Error.pm -RPM/Header.pm -RPM/Header.xs -typemap -t/00_load.t +ChangeLog Change history +MANIFEST This file +Makefile.PL MakeMaker file +README Overview +RPM.h C header, declarations, etc. +RPM.pm Perl code for top-level functionality +RPM.xs C/XS code for top-level stuff and RPM::Error +RPM/Constants.pm Perl code for constants (export lists, etc.) +RPM/Constants.xs C/XS code for constants +RPM/Database.pm Perl code for database access +RPM/Database.xs C/XS code for database +RPM/Error.pm Perl code for the error package +RPM/Header.pm Perl code for headers +RPM/Header.xs C/XS code for headers +typemap Type-mappings for xsubpp to manage headers and database +t/00_load.t Test suite t/01_database.t t/02_headers.t t/03_errors.t diff --git a/Perl-RPM/README b/Perl-RPM/README index 0689592e4..f6263ec9e 100644 --- a/Perl-RPM/README +++ b/Perl-RPM/README @@ -1,6 +1,6 @@ Perl-RPM - Native bindings to the RPM Package Manager API for Perl -Version 0.1 (first alpha) +Version 0.2 (second alpha) WHAT IS IT @@ -40,8 +40,9 @@ Please send any reports of problems or bugs to rjray@blackperl.com. CHANGES -This is the first release. At present, only RPM::Database and RPM::Header -are implemented. +This is the second release. In addition to some bug fixes, this release adds +some documentation, more test suites, and error management via the RPM::Error +package. LICENSE diff --git a/Perl-RPM/RPM.h b/Perl-RPM/RPM.h index 27a5fa1dc..6203744a8 100644 --- a/Perl-RPM/RPM.h +++ b/Perl-RPM/RPM.h @@ -1,5 +1,5 @@ /* - * $Id: RPM.h,v 1.2 2000/05/27 05:22:51 rjray Exp $ + * $Id: RPM.h,v 1.3 2000/05/30 01:03:13 rjray Exp $ * * Various C-specific decls/includes/etc. for the RPM linkage */ @@ -126,26 +126,26 @@ typedef RPM_Header_datum* RPM__Header__datum; // their native modules. // // RPM.xs: -extern int tag2num(const char *); -extern const char* num2tag(int); -extern void clear_errors(void); -extern SV* set_error_callback(SV *); -extern void rpm_error(int, const char *); +extern int tag2num(pTHX_ const char *); +extern const char* num2tag(pTHX_ int); +extern void clear_errors(pTHX); +extern SV* set_error_callback(pTHX_ SV *); +extern void rpm_error(pTHX_ int, const char *); // RPM/Header.xs: -extern const char* sv2key(SV *); -extern RPM__Header rpmhdr_TIEHASH(SV *, SV *, int); -extern AV* rpmhdr_FETCH(RPM__Header, SV *, const char *, int, int); -extern int rpmhdr_STORE(RPM__Header, SV *, AV *); -extern int rpmhdr_DELETE(RPM__Header, SV *); -extern int rpmhdr_EXISTS(RPM__Header, SV *); -extern unsigned int rpmhdr_size(RPM__Header); -extern int rpmhdr_tagtype(RPM__Header, SV *); -extern int rpmhdr_write(RPM__Header, SV *, int); +extern const char* sv2key(pTHX_ SV *); +extern RPM__Header rpmhdr_TIEHASH(pTHX_ SV *, SV *, int); +extern AV* rpmhdr_FETCH(pTHX_ RPM__Header, SV *, const char *, int, int); +extern int rpmhdr_STORE(pTHX_ RPM__Header, SV *, AV *); +extern int rpmhdr_DELETE(pTHX_ RPM__Header, SV *); +extern int rpmhdr_EXISTS(pTHX_ RPM__Header, SV *); +extern unsigned int rpmhdr_size(pTHX_ RPM__Header); +extern int rpmhdr_tagtype(pTHX_ RPM__Header, SV *); +extern int rpmhdr_write(pTHX_ RPM__Header, SV *, int); // RPM/Database.xs: -extern RPM__Database rpmdb_TIEHASH(char *, SV *); -extern RPM__Header rpmdb_FETCH(RPM__Database, SV *); -extern int rpmdb_EXISTS(RPM__Database, SV *); +extern RPM__Database rpmdb_TIEHASH(pTHX_ char *, SV *); +extern RPM__Header rpmdb_FETCH(pTHX_ RPM__Database, SV *); +extern int rpmdb_EXISTS(pTHX_ RPM__Database, SV *); #endif /* H_RPM_XS_HDR */ diff --git a/Perl-RPM/RPM.pm b/Perl-RPM/RPM.pm index 334bf2922..2a3f348f2 100644 --- a/Perl-RPM/RPM.pm +++ b/Perl-RPM/RPM.pm @@ -10,9 +10,9 @@ require Exporter; @ISA = qw(Exporter DynaLoader); $VERSION = '0.2'; -$revision = do { my @r=(q$Revision: 1.2 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; +$revision = do { my @r=(q$Revision: 1.3 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; -@EXPORT = qw(GetOsName GetArchName); +@EXPORT = qw(rpm_osname rpm_archname); @EXPORT_OK = @EXPORT; bootstrap RPM $VERSION; @@ -53,13 +53,13 @@ The following utility functions are exported by default from B<RPM>: =over -=item GetOsName +=item rpm_osname Returns the text name of the O/S, as derived from the B<rpm> configuration files. This is the O/S token that B<rpm> will use to refer to the running system. -=item GetArchName +=item rpm_archname As above, but returns the architecture string instead. Again, this may not directly match the running system, but rather is the value that B<rpm> is diff --git a/Perl-RPM/RPM.xs b/Perl-RPM/RPM.xs index fc944494f..ae401f497 100644 --- a/Perl-RPM/RPM.xs +++ b/Perl-RPM/RPM.xs @@ -4,7 +4,7 @@ #include "RPM.h" -static char * const rcsid = "$Id: RPM.xs,v 1.2 2000/05/27 05:22:51 rjray Exp $"; +static char * const rcsid = "$Id: RPM.xs,v 1.3 2000/05/30 01:03:13 rjray Exp $"; extern XS(boot_RPM__Constants); extern XS(boot_RPM__Header); @@ -15,7 +15,7 @@ static HV* num2tag_priv; static SV* errSV; static CV* err_callback; -static void setup_tag_mappings(void) +static void setup_tag_mappings(pTHX) { const char* tag; int num; @@ -42,7 +42,7 @@ static void setup_tag_mappings(void) } } -int tag2num(const char* tag) +int tag2num(pTHX_ const char* tag) { SV** svp; @@ -55,10 +55,9 @@ int tag2num(const char* tag) return (SvIV(*svp)); } -const char* num2tag(int num) +const char* num2tag(pTHX_ int num) { SV** svp; - STRLEN na; char str_num[8]; SV* tmp; @@ -68,10 +67,10 @@ const char* num2tag(int num) if (! (svp && SvPOK(*svp))) return Nullch; - return (SvPV(*svp, na)); + return (SvPV(*svp, PL_na)); } -char* rpm_GetOsName(void) +char* rpm_rpm_osname(void) { char* os_name; int os_val; @@ -80,7 +79,7 @@ char* rpm_GetOsName(void) return os_name; } -char* rpm_GetArchName(void) +char* rpm_rpm_archname(void) { char* arch_name; int arch_val; @@ -91,7 +90,7 @@ char* rpm_GetArchName(void) // 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) +static void rpm_catch_errors(pTHX) { int error_code; char* error_string; @@ -132,7 +131,7 @@ static void rpm_catch_errors(void) } // This is just to make available an easy way to clear both sides of $RPM::err -void clear_errors(void) +void clear_errors(pTHX) { sv_setsv(errSV, newSVpv("", 0)); sv_setiv(errSV, 0); @@ -141,11 +140,11 @@ void clear_errors(void) return; } -SV* set_error_callback(SV* newcb) +SV* set_error_callback(pTHX_ SV* newcb) { - CV* oldcb; + SV* oldcb; - oldcb = err_callback; + oldcb = (err_callback) ? newRV((SV *)err_callback) : newSVsv(&PL_sv_undef); if (SvROK(newcb)) newcb = SvRV(newcb); if (SvTYPE(newcb) == SVt_PVCV) @@ -154,9 +153,8 @@ SV* set_error_callback(SV* newcb) { char* fn_name; char* sv_name; - STRLEN len; - sv_name = SvPV(newcb, len); + sv_name = SvPV(newcb, PL_na); if (! strstr(sv_name, "::")) { Newz(TRUE, fn_name, strlen(sv_name) + 7, char); @@ -173,7 +171,7 @@ SV* set_error_callback(SV* newcb) err_callback = Null(CV *); } - return (SV *)oldcb; + return oldcb; } void rpm_error(int code, const char* message) @@ -189,10 +187,16 @@ 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) @@ -205,11 +209,11 @@ MODULE = RPM PACKAGE = RPM PREFIX = rpm_ char* -rpm_GetOsName() +rpm_rpm_osname() PROTOTYPE: char* -rpm_GetArchName() +rpm_rpm_archname() PROTOTYPE: @@ -227,7 +231,7 @@ BOOT: setup_tag_mappings(); rpmErrorSetCallback(rpm_catch_errors); - err_callback = Null(CV *); + err_callback = Nullcv; newXS("RPM::bootstrap_Constants", boot_RPM__Constants, file); newXS("RPM::bootstrap_Header", boot_RPM__Header, file); diff --git a/Perl-RPM/RPM/Constants.xs b/Perl-RPM/RPM/Constants.xs index 882725fd2..b5fbac6f6 100644 --- a/Perl-RPM/RPM/Constants.xs +++ b/Perl-RPM/RPM/Constants.xs @@ -4,7 +4,7 @@ #include "RPM.h" -static char * const rcsid = "$Id: Constants.xs,v 1.1 2000/05/27 03:54:14 rjray Exp $"; +static char * const rcsid = "$Id: Constants.xs,v 1.2 2000/05/30 01:03:13 rjray Exp $"; static int not_here(char *s) @@ -17,6 +17,7 @@ static int constant(char *name, int arg) { errno = 0; + switch (*name) { case 'A': if (strEQ(name, "ADD_SIGNATURE")) diff --git a/Perl-RPM/RPM/Database.pm b/Perl-RPM/RPM/Database.pm index 94edc2d8d..b8ecce0dd 100644 --- a/Perl-RPM/RPM/Database.pm +++ b/Perl-RPM/RPM/Database.pm @@ -5,7 +5,7 @@ # ############################################################################### # -# $Id: Database.pm,v 1.1 2000/05/27 03:54:14 rjray Exp $ +# $Id: Database.pm,v 1.2 2000/05/30 01:03:13 rjray Exp $ # # Description: The RPM::Database class provides access to the RPM database # as a tied hash, whose keys are taken as the names of @@ -37,7 +37,7 @@ require RPM; require RPM::Header; $VERSION = $RPM::VERSION; -$revision = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; +$revision = do { my @r=(q$Revision: 1.2 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; 1; @@ -122,31 +122,31 @@ This rebuilds the database (same as "rpm --rebuilddb"). As with B<init> above, this requires adequate permissions and must be invoked as a static method. -=item FindByFile(file) +=item find_by_file(file) Returns a list of B<RPM::Header> objects that correspond to the package(s) claiming ownership of the file "file". -=item FindByGroup(group) +=item find_by_group(group) Returns of a list of headers for all packages flagged as being in the group specified. -=item FindByProvides(provides) +=item find_by_provides(provides) Search as above, but based on which packages provide the file/object specified as "provides". -=item FindByRequiredBy(requires) +=item find_by_required_by(requires) Return a list of headers for the packages that directly depend on the specified package for installation and operation. -=item FindByConflicts(conflicts) +=item find_by_conflicts(conflicts) List those packages that have conflicts based on the value of "conflicts". -=item FindByPackage(package) +=item find_by_package(package) This performs the search by a specific package name. This is the API call used by the FETCH tied-hash method, but this differs in that if there is diff --git a/Perl-RPM/RPM/Database.xs b/Perl-RPM/RPM/Database.xs index 627275b56..cff72a766 100644 --- a/Perl-RPM/RPM/Database.xs +++ b/Perl-RPM/RPM/Database.xs @@ -5,7 +5,7 @@ #include <fcntl.h> #include "RPM.h" -static char * const rcsid = "$Id: Database.xs,v 1.1 2000/05/27 03:54:15 rjray Exp $"; +static char * const rcsid = "$Id: Database.xs,v 1.2 2000/05/30 01:03:13 rjray Exp $"; // // Use this define for deriving the saved rpmdb struct, rather than coding @@ -30,7 +30,7 @@ static char * const rcsid = "$Id: Database.xs,v 1.1 2000/05/27 03:54:15 rjray Ex // arguments as needed. The return value is expected to be either NULL or a // valid RPM__Database value (which the XS wrapper will fix up). // -RPM__Database rpmdb_TIEHASH(char* class, SV* opts) +RPM__Database rpmdb_TIEHASH(pTHX_ char* class, SV* opts) { char* root = (char *)NULL; int mode = O_RDONLY; @@ -95,7 +95,7 @@ RPM__Database rpmdb_TIEHASH(char* class, SV* opts) return TIEHASH; } -RPM__Header rpmdb_FETCH(RPM__Database self, SV* key) +RPM__Header rpmdb_FETCH(pTHX_ RPM__Database self, SV* key) { const char* name = NULL; // For the actual name out of (SV *)key int namelen; // Arg for SvPV(..., len) @@ -106,7 +106,7 @@ RPM__Header rpmdb_FETCH(RPM__Database self, SV* key) RPM_Database* dbstruct; // This is the struct used to hold C-level data // Any successful operation will re-assign this - FETCH = (RPM__Header)newSVsv(&sv_undef); + FETCH = (RPM__Header)newSVsv(&PL_sv_undef); dbstruct_from_object_ret(svp, dbstruct, self, FETCH); // De-reference key, if it is a reference @@ -178,7 +178,7 @@ RPM__Header rpmdb_FETCH(RPM__Database self, SV* key) // An error results in hdr getting NULL, which is just fine if (hdr) { - FETCH = rpmhdr_TIEHASH(sv_2mortal(newSVpv("RPM::Header", 12)), + FETCH = rpmhdr_TIEHASH(aTHX_ sv_2mortal(newSVpv("RPM::Header", 12)), sv_2mortal(newRV((SV *)hdr)), RPM_HEADER_FROM_REF | RPM_HEADER_READONLY); // If name is no longer NULL, it means our vector in was a string @@ -193,12 +193,12 @@ RPM__Header rpmdb_FETCH(RPM__Database self, SV* key) return FETCH; } -int rpmdb_EXISTS(RPM__Database self, SV* key) +int rpmdb_EXISTS(pTHX_ RPM__Database self, SV* key) { SV* tmp; - tmp = (SV *)rpmdb_FETCH(self, key); - // There is probably a cleaner test for (SV *)tmp == sv_undef + tmp = (SV *)rpmdb_FETCH(aTHX_ self, key); + // There is probably a cleaner test for (SV *)tmp == PL_sv_undef return (SvANY(tmp) != NULL); } @@ -206,7 +206,7 @@ int rpmdb_EXISTS(RPM__Database self, SV* key) // In these cases, the transition is based on the last offset fetched, which // we store on the struct part of self. We don't have to worry about an // iterator struct. -int rpmdb_FIRSTKEY(RPM__Database self, SV** key, RPM__Header* value) +int rpmdb_FIRSTKEY(pTHX_ RPM__Database self, SV** key, RPM__Header* value) { RPM_Database* dbstruct; SV** svp; @@ -219,15 +219,15 @@ int rpmdb_FIRSTKEY(RPM__Database self, SV** key, RPM__Header* value) if (! (dbstruct->current_rec = rpmdbFirstRecNum(dbstruct->dbp))) return 0; - *value = rpmdb_FETCH(self, newSViv(dbstruct->current_rec)); - tmpav = rpmhdr_FETCH(*value, newSVpv("name", 4), Nullch, 0, 0); + *value = rpmdb_FETCH(aTHX_ self, newSViv(dbstruct->current_rec)); + tmpav = rpmhdr_FETCH(aTHX_ *value, newSVpv("name", 4), Nullch, 0, 0); svp = av_fetch(tmpav, 0, FALSE); *key = newSVsv(*svp); return 1; } -int rpmdb_NEXTKEY(RPM__Database self, SV* key, +int rpmdb_NEXTKEY(pTHX_ RPM__Database self, SV* key, SV** nextkey, RPM__Header* nextvalue) { RPM_Database* dbstruct; @@ -240,15 +240,15 @@ int rpmdb_NEXTKEY(RPM__Database self, SV* key, dbstruct->current_rec))) return 0; - *nextvalue = rpmdb_FETCH(self, newSViv(dbstruct->current_rec)); - tmpav = rpmhdr_FETCH(*nextvalue, newSVpv("name", 4), Nullch, 0, 0); + *nextvalue = rpmdb_FETCH(aTHX_ self, newSViv(dbstruct->current_rec)); + tmpav = rpmhdr_FETCH(aTHX_ *nextvalue, newSVpv("name", 4), Nullch, 0, 0); svp = av_fetch(tmpav, 0, FALSE); *nextkey = newSVsv(*svp); return 1; } -void rpmdb_DESTROY(RPM__Database self) +void rpmdb_DESTROY(pTHX_ RPM__Database self) { SV** svp; RPM_Database* dbstruct; // This is the struct used to hold C-level data @@ -273,7 +273,7 @@ int rpmdb_rebuild(const char* class, const char* root) // This is a front-end to all the rpmdbFindBy*() set, including FindByPackage // which differs from FETCH above in that if there is actually more than one // match, all will be returned. -AV* rpmdb_find_by_whatever(RPM__Database self, SV* string, int idx) +AV* rpmdb_find_by_whatever(pTHX_ RPM__Database self, SV* string, int idx) { const char* str = NULL; // For the actual string out of (SV *)string STRLEN len; // Arg for SvPV(..., len) @@ -322,7 +322,7 @@ AV* rpmdb_find_by_whatever(RPM__Database self, SV* string, int idx) for (loop = 0; loop < dbstruct->index_set->count; loop++) { idx = dbstruct->index_set->recs[loop].recOffset; - tmp_hdr = rpmdb_FETCH(self, sv_2mortal(newSViv(idx))); + tmp_hdr = rpmdb_FETCH(aTHX_ self, sv_2mortal(newSViv(idx))); av_store(return_val, loop, sv_2mortal(newSViv((I32)tmp_hdr))); } } @@ -338,12 +338,20 @@ rpmdb_TIEHASH(class, opts=NULL) char* class; SV* opts; PROTOTYPE: $;$ + CODE: + RETVAL = rpmdb_TIEHASH(aTHX_ class, opts); + OUTPUT: + RETVAL RPM::Header rpmdb_FETCH(self, key) RPM::Database self; SV* key; PROTOTYPE: $$ + CODE: + RETVAL = rpmdb_FETCH(aTHX_ self, key); + OUTPUT: + RETVAL int rpmdb_STORE(self, key, value) @@ -389,6 +397,10 @@ rpmdb_EXISTS(self, key) RPM::Database self; SV* key; PROTOTYPE: $$ + CODE: + RETVAL = rpmdb_EXISTS(aTHX_ self, key); + OUTPUT: + RETVAL void rpmdb_FIRSTKEY(self) @@ -401,10 +413,10 @@ rpmdb_FIRSTKEY(self) { RPM__Header hvalue; - if (! rpmdb_FIRSTKEY(self, &key, &hvalue)) + if (! rpmdb_FIRSTKEY(aTHX_ self, &key, &hvalue)) { - key = newSVsv(&sv_undef); - value = newSVsv(&sv_undef); + key = newSVsv(&PL_sv_undef); + value = newSVsv(&PL_sv_undef); } else value = newRV((SV *)hvalue); @@ -426,10 +438,10 @@ rpmdb_NEXTKEY(self, key=NULL) { RPM__Header hvalue; - if (! rpmdb_NEXTKEY(self, key, &nextkey, &hvalue)) + if (! rpmdb_NEXTKEY(aTHX_ self, key, &nextkey, &hvalue)) { - nextkey = newSVsv(&sv_undef); - nextvalue = newRV(&sv_undef); + nextkey = newSVsv(&PL_sv_undef); + nextvalue = newRV(&PL_sv_undef); } else nextvalue = newRV((SV *)hvalue); @@ -443,6 +455,8 @@ void rpmdb_DESTROY(self) RPM::Database self; PROTOTYPE: $ + CODE: + rpmdb_DESTROY(self); int rpmdb_init(class, root=NULL, perms=O_RDWR) @@ -464,17 +478,17 @@ rpmdb_rebuild(class, root=NULL) croak("RPM::Database::rebuild must be called as a static method"); void -rpmdb_FindByFile(self, string) +rpmdb_find_by_file(self, string) RPM::Database self; SV* string; PROTOTYPE: $$ ALIAS: # These should not be hard-coded, fix in later rev - FindByGroup = 1 - FindByProvides = 2 - FindByRequiredBy = 3 - FindByConflicts = 4 - FindByPackage = 5 + find_by_group = 1 + find_by_provides = 2 + find_by_required_by = 3 + find_by_conflicts = 4 + find_by_package = 5 PPCODE: { AV* matches; @@ -483,7 +497,7 @@ rpmdb_FindByFile(self, string) RPM__Header hdr; SV* hdr_ptr; - matches = rpmdb_find_by_whatever(self, string, ix); + matches = rpmdb_find_by_whatever(aTHX_ self, string, ix); if ((len = av_len(matches)) != -1) { // We have (len+1) elements in the array to put onto the stack @@ -501,7 +515,7 @@ rpmdb_FindByFile(self, string) hv_magic(hdr, (GV *)Nullhv, 'P'); } else - hdr_ptr = newSVsv(&sv_undef); + hdr_ptr = newSVsv(&PL_sv_undef); PUSHs(hdr_ptr); len--; } diff --git a/Perl-RPM/RPM/Error.pm b/Perl-RPM/RPM/Error.pm index 5372e2152..bf419474f 100644 --- a/Perl-RPM/RPM/Error.pm +++ b/Perl-RPM/RPM/Error.pm @@ -7,7 +7,7 @@ # ############################################################################### # -# $Id: Error.pm,v 1.1 2000/05/27 03:53:56 rjray Exp $ +# $Id: Error.pm,v 1.2 2000/05/30 01:03:13 rjray Exp $ # # Description: Error-management support that cooperates with the primary # Perl/C error glue. @@ -34,7 +34,7 @@ require RPM; @ISA = qw(Exporter); $VERSION = $RPM::VERSION; -$revision = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; +$revision = do { my @r=(q$Revision: 1.2 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; @EXPORT = qw(clear_errors set_error_callback rpm_error); @EXPORT_OK = @EXPORT; @@ -90,7 +90,7 @@ Clears both the numeric and string values of C<$RPM::err>. =item $old_cb = set_error_callback($subr) Set a (new) callback to be invoked whenever a new error is flagged. Returns -the old (existing) callback value if there was one. +the old (existing) callback value if there was one, C<undef> otherwise. The parameter to this call should be either a subroutine reference or a closure. A subroutine name may be passed; if so, it should either be given @@ -112,9 +112,6 @@ callback is set to a null value. The code value passed to B<rpm_error> is not checked against the list of valid constants before assignment. -The B<set_error_callback> should return the current callback, which could then -be restored. This does not currently work correctly, and should not be used. - =head1 SEE ALSO L<RPM>, L<perl>, L<rpm> diff --git a/Perl-RPM/RPM/Header.xs b/Perl-RPM/RPM/Header.xs index b3b0fc6fe..962104646 100644 --- a/Perl-RPM/RPM/Header.xs +++ b/Perl-RPM/RPM/Header.xs @@ -5,7 +5,7 @@ #include <ctype.h> #include "RPM.h" -static char * const rcsid = "$Id: Header.xs,v 1.1 2000/05/27 03:54:15 rjray Exp $"; +static char * const rcsid = "$Id: Header.xs,v 1.2 2000/05/30 01:03:13 rjray Exp $"; // // Use this define for deriving the saved Header struct, rather than coding @@ -26,33 +26,30 @@ static char * const rcsid = "$Id: Header.xs,v 1.1 2000/05/27 03:54:15 rjray Exp // Some simple functions to manage key-to-SV* transactions, since these // gets used frequently. -const char* sv2key(SV* key) +const char* sv2key(pTHX_ SV* key) { const char* new_key; - STRLEN na; // De-reference key, if it is a reference if (SvROK(key)) key = SvRV(key); - new_key = SvPV(key, na); + new_key = SvPV(key, PL_na); return new_key; } -SV* key2sv(const char* key) +SV* key2sv(pTHX_ const char* key) { - STRLEN na; - - return (sv_2mortal(newSVpv((char *)key, na))); + return (sv_2mortal(newSVpv((char *)key, PL_na))); } -static SV* ikey2sv(int key) +static SV* ikey2sv(pTHX_ int key) { return (sv_2mortal(newSViv(key))); } // This creates a header data-field from the passed-in data -static AV* rpmhdr_create(const char* data, int type, int size) +static AV* rpmhdr_create(pTHX_ const char* data, int type, int size) { char urk[2]; AV* new_list; @@ -147,7 +144,7 @@ static AV* rpmhdr_create(const char* data, int type, int size) // Special case for exactly one RPM_STRING_TYPE if (type == RPM_STRING_TYPE && size == 1) { - new_item = newSVsv(&sv_undef); + new_item = newSVsv(&PL_sv_undef); sv_setpvn(new_item, (char *)data, strlen((char *)data)); av_store(new_list, 0, sv_2mortal(new_item)); SvREFCNT_inc(new_item); @@ -158,7 +155,7 @@ static AV* rpmhdr_create(const char* data, int type, int size) idx < size; idx++, loop++) { - new_item = newSVsv(&sv_undef); + new_item = newSVsv(&PL_sv_undef); sv_setpvn(new_item, *loop, strlen(*loop)); av_store(new_list, idx, sv_2mortal(new_item)); SvREFCNT_inc(new_item); @@ -212,7 +209,7 @@ static int new_from_fname(const char* source, RPM_Header* new_hdr) return(new_from_fd_t(fd, new_hdr)); } -RPM__Header rpmhdr_TIEHASH(SV* class, SV* source, int flags) +RPM__Header rpmhdr_TIEHASH(pTHX_ SV* class, SV* source, int flags) { char* fname; int fname_len; @@ -236,7 +233,7 @@ RPM__Header rpmhdr_TIEHASH(SV* class, SV* source, int flags) fname = SvPV(source, fname_len); if (! new_from_fname(fname, hdr_struct)) { - return ((RPM__Header)newSVsv(&sv_undef)); + return ((RPM__Header)newSVsv(&PL_sv_undef)); } } else if (IoIFP(sv_2io(source))) @@ -244,7 +241,7 @@ RPM__Header rpmhdr_TIEHASH(SV* class, SV* source, int flags) if (! new_from_fd(PerlIO_fileno(IoIFP(sv_2io(source))), hdr_struct)) { - return ((RPM__Header)newSVsv(&sv_undef)); + return ((RPM__Header)newSVsv(&PL_sv_undef)); } } else @@ -280,7 +277,7 @@ RPM__Header rpmhdr_TIEHASH(SV* class, SV* source, int flags) return TIEHASH; } -AV* rpmhdr_FETCH(RPM__Header self, SV* key, +AV* rpmhdr_FETCH(pTHX_ RPM__Header self, SV* key, const char* data_in, int type_in, int size_in) { const char* name; // For the actual name out of (SV *)key @@ -293,11 +290,11 @@ AV* rpmhdr_FETCH(RPM__Header self, SV* key, int i; FETCH = newAV(); - av_store(FETCH, 0, newSVsv(&sv_undef)); + av_store(FETCH, 0, newSVsv(&PL_sv_undef)); header_from_object_ret(svp, hdr, self, FETCH); - name = sv2key(key); + name = sv2key(aTHX_ key); if (! (name && (namelen = strlen(name)))) return FETCH; @@ -327,7 +324,7 @@ AV* rpmhdr_FETCH(RPM__Header self, SV* key, { // In some cases (particarly the iterators) we could be called // with the data already available, but not on the hash just yet. - AV* new_item = rpmhdr_create(data_in, type_in, size_in); + AV* new_item = rpmhdr_create(aTHX_ data_in, type_in, size_in); hv_store_nomg(self, uc_name, namelen, newRV_noinc((SV *)new_item), FALSE); @@ -346,7 +343,7 @@ AV* rpmhdr_FETCH(RPM__Header self, SV* key, char urk[2]; // Get the #define value for the tag from the hash made at boot-up - if (! (tag_by_num = tag2num(uc_name))) + if (! (tag_by_num = tag2num(aTHX_ uc_name))) { // Later we need to set some sort of error message Safefree(uc_name); @@ -360,7 +357,7 @@ AV* rpmhdr_FETCH(RPM__Header self, SV* key, Safefree(uc_name); return FETCH; } - new_item = rpmhdr_create(new_item_p, new_item_type, size); + new_item = rpmhdr_create(aTHX_ new_item_p, new_item_type, size); hv_store_nomg(self, uc_name, namelen, newRV_noinc((SV *)new_item), FALSE); @@ -379,7 +376,7 @@ AV* rpmhdr_FETCH(RPM__Header self, SV* key, // Store the data in "value" both in the header and in the hash associated // with "self". // -int rpmhdr_STORE(RPM__Header self, SV* key, AV* value) +int rpmhdr_STORE(pTHX_ RPM__Header self, SV* key, AV* value) { SV** svp; const char* name; @@ -394,7 +391,7 @@ int rpmhdr_STORE(RPM__Header self, SV* key, AV* value) if (hdr->read_only) return 0; - name = sv2key(key); + name = sv2key(aTHX_ key); if (! (name && (namelen = strlen(name)))) return 0; @@ -405,7 +402,7 @@ int rpmhdr_STORE(RPM__Header self, SV* key, AV* value) // Get the numerical tag value for this name. If none exists, this means // that there is no such tag, which is an error in this case - if (! (num_ent = tag2num(uc_name))) + if (! (num_ent = tag2num(aTHX_ uc_name))) return 0; // Setting/STORE-ing means do the following: @@ -611,7 +608,7 @@ int rpmhdr_STORE(RPM__Header self, SV* key, AV* value) return 1; } -int rpmhdr_DELETE(RPM__Header self, SV* key) +int rpmhdr_DELETE(pTHX_ RPM__Header self, SV* key) { const char* name; // For the actual name out of (SV *)key int namelen; // Arg for SvPV(..., len) @@ -624,7 +621,7 @@ int rpmhdr_DELETE(RPM__Header self, SV* key) if (hdr->read_only) return 0; - name = sv2key(key); + name = sv2key(aTHX_ key); if (! (name && (namelen = strlen(name)))) return 0; @@ -635,7 +632,7 @@ int rpmhdr_DELETE(RPM__Header self, SV* key) // Get the numerical tag value for this name. If none exists, this means // that there is no such tag, which isn't really an error (so return 1). - if (! (num = tag2num(uc_name))) + if (! (num = tag2num(aTHX_ uc_name))) { retval = 1; } @@ -664,7 +661,7 @@ int rpmhdr_DELETE(RPM__Header self, SV* key) return retval; } -int rpmhdr_EXISTS(RPM__Header self, SV* key) +int rpmhdr_EXISTS(pTHX_ RPM__Header self, SV* key) { const char* name; char* uc_name; @@ -673,7 +670,7 @@ int rpmhdr_EXISTS(RPM__Header self, SV* key) RPM_Header* hdr; header_from_object_ret(svp, hdr, self, 0); - name = sv2key(key); + name = sv2key(aTHX_ key); if (! (name && (namelen = strlen(name)))) return 0; @@ -684,7 +681,7 @@ int rpmhdr_EXISTS(RPM__Header self, SV* key) uc_name[i] = '\0'; // Get the #define value for the tag from the hash made at boot-up - tag_by_num = tag2num(uc_name); + tag_by_num = tag2num(aTHX_ uc_name); Safefree(uc_name); if (! tag_by_num) // Later we need to set some sort of error message @@ -693,7 +690,7 @@ int rpmhdr_EXISTS(RPM__Header self, SV* key) return (headerIsEntry(hdr->hdr, tag_by_num)); } -int rpmhdr_FIRSTKEY(RPM__Header self, SV** key, AV** value) +int rpmhdr_FIRSTKEY(pTHX_ RPM__Header self, SV** key, AV** value) { SV** svp; RPM_Header* hdr; @@ -718,14 +715,15 @@ int rpmhdr_FIRSTKEY(RPM__Header self, SV** key, AV** value) if (! headerNextIterator(hdr->iterator, &tag, &type, (void **)&ptr, &size)) return 0; - tagname = num2tag(tag); + tagname = num2tag(aTHX_ tag); *key = newSVpv((char *)tagname, strlen(tagname)); - *value = rpmhdr_FETCH(self, *key, ptr, type, size); + *value = rpmhdr_FETCH(aTHX_ self, *key, ptr, type, size); return 1; } -int rpmhdr_NEXTKEY(RPM__Header self, SV* key, SV** nextkey, AV** nextvalue) +int rpmhdr_NEXTKEY(pTHX_ RPM__Header self, SV* key, + SV** nextkey, AV** nextvalue) { SV** svp; RPM_Header* hdr; @@ -742,14 +740,14 @@ int rpmhdr_NEXTKEY(RPM__Header self, SV* key, SV** nextkey, AV** nextvalue) if (! headerNextIterator(hdr->iterator, &tag, &type, (void **)&ptr, &size)) return 0; - tagname = num2tag(tag); + tagname = num2tag(aTHX_ tag); *nextkey = newSVpv((char *)tagname, strlen(tagname)); - *nextvalue = rpmhdr_FETCH(self, *nextkey, ptr, type, size); + *nextvalue = rpmhdr_FETCH(aTHX_ self, *nextkey, ptr, type, size); return 1; } -void rpmhdr_DESTROY(RPM__Header self) +void rpmhdr_DESTROY(pTHX_ RPM__Header self) { SV** svp; RPM_Header* hdr; @@ -762,7 +760,7 @@ void rpmhdr_DESTROY(RPM__Header self) headerFree(hdr->hdr); } -unsigned int rpmhdr_size(RPM__Header self) +unsigned int rpmhdr_size(pTHX_ RPM__Header self) { SV** svp; RPM_Header* hdr; @@ -775,7 +773,7 @@ unsigned int rpmhdr_size(RPM__Header self) return(headerSizeof(hdr->hdr, HEADER_MAGIC_YES)); } -int rpmhdr_tagtype(RPM__Header self, SV* key) +int rpmhdr_tagtype(pTHX_ RPM__Header self, SV* key) { STRLEN namelen; const char* name; @@ -783,7 +781,7 @@ int rpmhdr_tagtype(RPM__Header self, SV* key) SV** svp; int i, retval; - name = sv2key(key); + name = sv2key(aTHX_ key); if (! (name && (namelen = strlen(name)))) return RPM_NULL_TYPE; @@ -807,7 +805,7 @@ int rpmhdr_tagtype(RPM__Header self, SV* key) // key that holds the type isn't available, either. // // Do a plain fetch (that is, leave magic on) to populate the other - AV* sub_fetch = rpmhdr_FETCH(self, key, Nullch, 0, 0); + AV* sub_fetch = rpmhdr_FETCH(aTHX_ self, key, Nullch, 0, 0); if (sub_fetch) { @@ -824,7 +822,7 @@ int rpmhdr_tagtype(RPM__Header self, SV* key) return retval; } -int rpmhdr_write(RPM__Header self, SV* gv_in, int magicp) +int rpmhdr_write(pTHX_ RPM__Header self, SV* gv_in, int magicp) { IO* io; PerlIO* fp; @@ -850,19 +848,20 @@ int rpmhdr_write(RPM__Header self, SV* gv_in, int magicp) } // Here starts the code for the RPM::Header::datum class -RPM__Header__datum rpmdatum_TIESCALAR(SV* class, SV* datum, int size, int type) +RPM__Header__datum rpmdatum_TIESCALAR(pTHX_ SV* class, + SV* datum, int size, int type) { } -SV* rpmdatum_FETCH(RPM__Header__datum self) +SV* rpmdatum_FETCH(pTHX_ RPM__Header__datum self) { } -SV* rpmdatum_STORE(RPM__Header__datum self, RPM__Header__datum newval) +SV* rpmdatum_STORE(pTHX_ RPM__Header__datum self, RPM__Header__datum newval) { } -void rpmdatum_DESTROY(RPM__Header__datum self) +void rpmdatum_DESTROY(pTHX_ RPM__Header__datum self) { } @@ -886,6 +885,10 @@ rpmhdr_TIEHASH(class, source=NULL, flags=0) SV* source; int flags; PROTOTYPE: $;$$ + CODE: + RETVAL = rpmhdr_TIEHASH(aTHX_ class, source, flags); + OUTPUT: + RETVAL AV* rpmhdr_FETCH(self, key) @@ -893,9 +896,9 @@ rpmhdr_FETCH(self, key) SV* key; PROTOTYPE: $$ CODE: - RETVAL = rpmhdr_FETCH(self, key, Nullch, 0, 0); + RETVAL = rpmhdr_FETCH(aTHX_ self, key, Nullch, 0, 0); OUTPUT: - RETVAL + RETVAL int rpmhdr_STORE(self, key, value) @@ -915,7 +918,7 @@ rpmhdr_STORE(self, key, value) av_store(avalue, 0, value); } - RETVAL = rpmhdr_STORE(self, key, avalue); + RETVAL = rpmhdr_STORE(aTHX_ self, key, avalue); } OUTPUT: RETVAL @@ -925,6 +928,10 @@ rpmhdr_DELETE(self, key) RPM::Header self; SV* key; PROTOTYPE: $$ + CODE: + RETVAL = rpmhdr_DELETE(aTHX_ self, key); + OUTPUT: + RETVAL int rpmhdr_CLEAR(self) @@ -943,6 +950,10 @@ rpmhdr_EXISTS(self, key) RPM::Header self; SV* key; PROTOTYPE: $$ + CODE: + RETVAL = rpmhdr_EXISTS(aTHX_ self, key); + OUTPUT: + RETVAL void rpmhdr_FIRSTKEY(self) @@ -954,9 +965,9 @@ rpmhdr_FIRSTKEY(self) int i; PPCODE: { - if (! rpmhdr_FIRSTKEY(self, &key, &value)) + if (! rpmhdr_FIRSTKEY(aTHX_ self, &key, &value)) { - key = newSVsv(&sv_undef); + key = newSVsv(&PL_sv_undef); value = newAV(); } @@ -975,9 +986,9 @@ rpmhdr_NEXTKEY(self, key=NULL) int i; PPCODE: { - if (! rpmhdr_NEXTKEY(self, key, &nextkey, &nextvalue)) + if (! rpmhdr_NEXTKEY(aTHX_ self, key, &nextkey, &nextvalue)) { - nextkey = newSVsv(&sv_undef); + nextkey = newSVsv(&PL_sv_undef); nextvalue = newAV(); } @@ -989,17 +1000,27 @@ void rpmhdr_DESTROY(self) RPM::Header self; PROTOTYPE: $ + CODE: + rpmhdr_DESTROY(aTHX_ self); unsigned int rpmhdr_size(self) RPM::Header self; PROTOTYPE: $ + CODE: + RETVAL = rpmhdr_size(aTHX_ self); + OUTPUT: + RETVAL int rpmhdr_tagtype(self, key) RPM::Header self; SV* key; PROTOTYPE: $$ + CODE: + RETVAL = rpmhdr_tagtype(aTHX_ self, key); + OUTPUT: + RETVAL int rpmhdr_write(self, gv, magicp=0) @@ -1016,45 +1037,7 @@ rpmhdr_write(self, gv, magicp=0) else flag = HEADER_MAGIC_YES; - RETVAL = rpmhdr_write(self, gv, flag); + RETVAL = rpmhdr_write(aTHX_ self, gv, flag); } OUTPUT: RETVAL - - -MODULE = RPM::Header PACKAGE = RPM::Header::datum PREFIX = rpmdatum_ - - -RPM::Header::datum -rpmdatum_TIESCALAR(class, data, size, type) - SV* class; - SV* data; - int size; - int type; - PROTOTYPE: $$$$ - -SV* -rpmdatum_FETCH(self) - RPM::Header::datum self; - PROTOTYPE: $ - -SV* -rpmdatum_STORE(self, newval) - RPM::Header::datum self; - RPM::Header::datum newval; - PROTOTYPE: $$ - -void -rpmdatum_DESTROY(self) - RPM::Header::datum self; - PROTOTYPE: $ - -int -rpmdatum_size(self) - RPM::Header::datum self; - PROTOTYPE: $ - -int -rpmdatum_type(self) - RPM::Header::datum self; - PROTOTYPE: $ diff --git a/Perl-RPM/t/01_database.t b/Perl-RPM/t/01_database.t index 8f89a62fe..badd066d3 100755 --- a/Perl-RPM/t/01_database.t +++ b/Perl-RPM/t/01_database.t @@ -45,7 +45,7 @@ $rpm = new RPM::Database; print "not " unless (defined $rpm and ref $rpm); print "ok 7\n"; -@matches = $rpm->FindByFile('/bin/rpm'); +@matches = $rpm->find_by_file('/bin/rpm'); # There should be exactly one match: print "not " unless (@matches == 1); print "ok 8\n"; @@ -54,7 +54,7 @@ print "not " unless ($matches[0]->{name}->[0] eq 'rpm'); print "ok 9\n"; # There may be more than one package that depends on rpm -@matches = $rpm->FindByRequiredBy('rpm'); +@matches = $rpm->find_by_required_by('rpm'); for (@matches) { $_ = $_->{name}->[0] } # As long as we see this one (it has to be present to build this package) print "not " unless (grep 'rpm-devel', @matches); diff --git a/Perl-RPM/t/03_errors.t b/Perl-RPM/t/03_errors.t index ca1206267..6e2ccad6e 100755 --- a/Perl-RPM/t/03_errors.t +++ b/Perl-RPM/t/03_errors.t @@ -9,7 +9,7 @@ use vars qw($called $string $oldcb); select(STDOUT); $| = 1; -print "1..9\n"; +print "1..11\n"; # tests 1-2: basic set rpm_error(RPMERR_BADARG, "Bad argument passed"); @@ -55,11 +55,21 @@ rpm_error(RPMERR_BADMAGIC, "badmagic"); print 'not ' unless ($called == 1 and $RPM::err == RPMERR_BADMAGIC); print "ok 8\n"; -set_error_callback(undef); +my $oldcb = set_error_callback(undef); $called = 0; rpm_error(RPMERR_BADDEV, "baddev"); print 'not ' if ($called); print "ok 9\n"; +print 'not ' unless (ref $oldcb eq 'CODE'); +print "ok 10\n"; + +set_error_callback($oldcb); +$called = 0; +rpm_error(RPMERR_BADMAGIC, "badmagic"); + +print 'not ' unless ($called == 1 and $RPM::err == RPMERR_BADMAGIC); +print "ok 11\n"; + exit 0; diff --git a/Perl-RPM/t/04_utils.t b/Perl-RPM/t/04_utils.t index 751f5687e..88c8be602 100755 --- a/Perl-RPM/t/04_utils.t +++ b/Perl-RPM/t/04_utils.t @@ -18,10 +18,10 @@ while (defined($line = <PIPE>)) } close(PIPE); -print 'not ' unless ($arch eq GetArchName); +print 'not ' unless ($arch eq rpm_archname); print "ok 1\n"; -print 'not ' unless ($os eq GetOsName); +print 'not ' unless ($os eq rpm_osname); print "ok 2\n"; exit; diff --git a/Perl-RPM/typemap b/Perl-RPM/typemap index 35c0cb1af..0a592a223 100644 --- a/Perl-RPM/typemap +++ b/Perl-RPM/typemap @@ -6,7 +6,6 @@ const char * T_PTROBJ RPM T_PTROBJ RPM::Database O_RPM_Database RPM::Header O_RPM_Header -RPM::Header::datum T_PTROBJ # # The following mappings for O_HvRV are taken directly from Dean Roehrich's |