diff options
| -rw-r--r-- | Perl-RPM/ChangeLog | 20 | ||||
| -rw-r--r-- | Perl-RPM/Makefile.PL | 33 | ||||
| -rw-r--r-- | Perl-RPM/RPM.h | 73 | ||||
| -rw-r--r-- | Perl-RPM/RPM.pm | 50 | ||||
| -rw-r--r-- | Perl-RPM/RPM.xs | 171 | ||||
| -rw-r--r-- | Perl-RPM/typemap | 1 |
6 files changed, 280 insertions, 68 deletions
diff --git a/Perl-RPM/ChangeLog b/Perl-RPM/ChangeLog index 1f3c5ffa4..4ed5cb576 100644 --- a/Perl-RPM/ChangeLog +++ b/Perl-RPM/ChangeLog @@ -12,3 +12,23 @@ Revision history for Perl extension RPM. exported symbols, rather than lengthening it). A basic top-level 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 + - second alpha + + Class for RPM::Error added. The code is in the RPM.xs file, but + the docs and accessors are done in RPM/Error.pm. + + All sub-classes moved to RPM/. + + More documentation added, especially to RPM::Constants. + + RPM::Constants had about a dozen or so trimmed out. + + Found error in Database.xs where the FIRSTKEY/NEXTKEY pair would + have returned string-ified references instead of package names, + because of not taking the first array element. I really plan to + change the RPM::Header::FETCH interface. + + Added two utility functions under the RPM::* space for getting O/S + and architecture names. diff --git a/Perl-RPM/Makefile.PL b/Perl-RPM/Makefile.PL index b99caa0e2..bb8c8fa48 100644 --- a/Perl-RPM/Makefile.PL +++ b/Perl-RPM/Makefile.PL @@ -1,10 +1,10 @@ use ExtUtils::MakeMaker; %XS = qw( - RPM.xs RPM.c - Constants/Constants.xs Constants/Constants.c - Database/Database.xs Database/Database.c - Header/Header.xs Header/Header.c + RPM.xs RPM.c + RPM/Constants.xs RPM/Constants.c + RPM/Database.xs RPM/Database.c + RPM/Header.xs RPM/Header.c ); @OBJECT = values %XS; @@ -14,21 +14,17 @@ for (@OBJECT) } $OBJECT = join(' ', @OBJECT); -@DIRS = qw(Constants Header Database); - %PM = map { ($from = $_) =~ s/xs$/pm/; - ($to = $from) =~ s|.*?/|RPM/|; - ($from, "\$(INST_LIBDIR)/$to"); } (sort keys %XS); + ($from, "\$(INST_LIBDIR)/$from"); } (sort keys %XS); +$PM{q(RPM/Error.pm)} = '$(INST_LIBDIR)/RPM/Error.pm'; -# Make symlinks for typemap in the sub-dirs -for (@DIRS) -{ - symlink '../typemap', "$_/typemap"; -} +# This shouldn't be necessary, I don't think, but for now it is +unlink 'RPM/typemap'; +symlink '../typemap', 'RPM/typemap'; # Cruft that MakeMaker wouldn't inherently know about -$CLEAN = join(' ', map { "$_/typemap" } @DIRS) . " $OBJECT"; -$CLEAN .= ' pod2html-* */pod2html-* *.html */*.html'; +$CLEAN = join(' ', values %XS) . " $OBJECT"; +$CLEAN .= ' pod2html-* */pod2html-* *.html */*.html RPM/typemap'; WriteMakefile( NAME => 'RPM', @@ -36,13 +32,13 @@ WriteMakefile( VERSION_FROM => 'RPM.pm', LIBS => '-lrpm -lpopt', DEFINE => '', - XS => \%XS, PM => \%PM, + XS => \%XS, OBJECT => $OBJECT, INC => '-I/usr/include/rpm', + DIR => [], dist => { COMPRESS => 'gzip -9f' }, clean => { FILES => $CLEAN }, - #realclean => { FILES => $CLEAN }, ); sub MY::c_o @@ -50,7 +46,8 @@ sub MY::c_o package MY; # so that "SUPER" works right my $text = shift->SUPER::c_o(@_); - $text =~ s/CCCMD.*$/$&\n\t\@if test -f `basename \$*.o` -a "`basename \$*.o`" != "\$*.o"; then mv `basename \$*.o` \$*.o; fi/m; + + $text =~ s/CCCMD.*$/$& -o \$*\$(OBJ_EXT)/gm; $text; } diff --git a/Perl-RPM/RPM.h b/Perl-RPM/RPM.h index d2deafb2e..27a5fa1dc 100644 --- a/Perl-RPM/RPM.h +++ b/Perl-RPM/RPM.h @@ -1,5 +1,5 @@ /* - * $Id: RPM.h,v 1.1 2000/05/22 08:37:23 rjray Exp $ + * $Id: RPM.h,v 1.2 2000/05/27 05:22:51 rjray Exp $ * * Various C-specific decls/includes/etc. for the RPM linkage */ @@ -40,9 +40,12 @@ #include <rpm/header.h> #include <rpm/dbindex.h> -extern const char* sv2key(SV *); -extern int tag2num(const char *); -extern const char* num2tag(int); +// +// This is the underlying struct that implements the interface to the RPM +// database. Since we need the actual object to be a hash, the struct will +// be stored as an SV (actually, a pointer to a struct) on a special key +// defined below. +// typedef struct { rpmdb dbp; @@ -54,6 +57,13 @@ typedef HV* RPM__Database; #define new_RPM__Database(x) x = newHV() +// +// This is the underlying struct that implements the interface to the RPM +// headers. As above, we need the actual object to be a hash, so the struct +// will be stored as an SV on the same sort of special key as RPM__Database +// uses. +// + typedef struct { Header hdr; // These three tags will probably cover at leas 80% of data requests @@ -79,13 +89,13 @@ typedef HV* RPM__Header; // Because the HV* are going to be set magical, the following is needed for // explicit fetch and store calls that are done within the tied FETCH/STORE #define hv_fetch_nomg(SVP, h, k, kl, f) \ - SvMAGICAL_off((SV *)(h)); \ - (SVP) = hv_fetch((h), (k), (kl), (f)); \ - SvMAGICAL_on((SV *)(h)) + SvMAGICAL_off((SV *)(h)); \ + (SVP) = hv_fetch((h), (k), (kl), (f)); \ + SvMAGICAL_on((SV *)(h)) #define hv_store_nomg(h, k, kl, v, f) \ - SvMAGICAL_off((SV *)(h)); \ - hv_store((h), (k), (kl), (v), (f)); \ - SvMAGICAL_on((SV *)(h)) + SvMAGICAL_off((SV *)(h)); \ + hv_store((h), (k), (kl), (v), (f)); \ + SvMAGICAL_on((SV *)(h)) // // This silly-looking key is what will be used on the RPM::Header and @@ -95,4 +105,47 @@ typedef HV* RPM__Header; // This must match! #define STRUCT_KEY_LEN 13 +// +// This struct will be used for RPM data type coming out of an RPM::Header +// object. It will be implemented as a tied scalar, so we shouldn't need any +// weird private-key voodoo like for the two previous. +// + +typedef struct { + SV* value; // May be an SV* or a ptr to an AV* + int size; // Number of items + int type; // Will match one of the RPM_*_TYPE values. +} RPM_Header_datum; + +typedef RPM_Header_datum* RPM__Header__datum; + +#define new_RPM__Header__datum(x) Newz(TRUE, (x), 1, RPM_Header_datum) + +// +// These represent the various interfaces that are allowed for use outside +// 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 *); + +// 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); + +// 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 *); + #endif /* H_RPM_XS_HDR */ diff --git a/Perl-RPM/RPM.pm b/Perl-RPM/RPM.pm index 9ab04e1ce..334bf2922 100644 --- a/Perl-RPM/RPM.pm +++ b/Perl-RPM/RPM.pm @@ -3,12 +3,17 @@ package RPM; use 5.005; use strict; use subs qw(bootstrap_Constants bootstrap_Header bootstrap_Database); -use vars qw($VERSION @ISA); +use vars qw($VERSION $revision @ISA @EXPORT @EXPORT_OK); require DynaLoader; +require Exporter; -@ISA = qw(DynaLoader); -$VERSION = '0.1'; +@ISA = qw(Exporter DynaLoader); +$VERSION = '0.2'; +$revision = do { my @r=(q$Revision: 1.2 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; + +@EXPORT = qw(GetOsName GetArchName); +@EXPORT_OK = @EXPORT; bootstrap RPM $VERSION; @@ -36,13 +41,41 @@ RPM - Perl interface to the API for the RPM Package Manager 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 -individual package headers, respectively. +individual package headers, respectively. The B<RPM::Error> package is +available, which provides support routines for signaling and catching +errors. Additionally, there is the B<RPM::Constants> package which provides +a number of values from the B<rpm> library, referred to by the same name used +at the C level. + +=head1 UTILITY FUNCTIONS + +The following utility functions are exported by default from B<RPM>: + +=over + +=item GetOsName + +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 + +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 +using. B<rpm> will use the lowest-matching architecture whenever possible, +for maximum cross-platform compatibility. + +=back =head1 DIAGNOSTICS -Direct binding to the internal error-management of B<rpm> is still under -development. At present, most operations generate their diagnostics to -STDERR. +When an error occurs in either the C-level B<rpm> library or internally +within these libraries, it is made available via a special dual-nature +variable B<$RPM::err>. When evaluated in a numeric context, it returns the +integer code value of the error. When taken in a string context, it returns +the text message associated with the error. This is intended to closely +mimic the behavior of the special Perl variable "C<$!>". =head1 CAVEATS @@ -51,7 +84,8 @@ subject to change in future releases. =head1 SEE ALSO -L<RPM::Database>, L<RPM::Header>, L<perl>, L<rpm> +L<RPM::Constants>, L<RPM::Database>, L<RPM::Error>, L<RPM::Header>, +L<perl>, L<rpm> =head1 AUTHOR diff --git a/Perl-RPM/RPM.xs b/Perl-RPM/RPM.xs index 8bb1eb4e8..fc944494f 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.1 2000/05/22 08:37:45 rjray Exp $"; +static char * const rcsid = "$Id: RPM.xs,v 1.2 2000/05/27 05:22:51 rjray Exp $"; extern XS(boot_RPM__Constants); extern XS(boot_RPM__Header); @@ -12,8 +12,10 @@ extern XS(boot_RPM__Database); static HV* tag2num_priv; static HV* num2tag_priv; +static SV* errSV; +static CV* err_callback; -void setup_tag_mappings(void) +static void setup_tag_mappings(void) { const char* tag; int num; @@ -40,17 +42,62 @@ void setup_tag_mappings(void) } } +int tag2num(const char* tag) +{ + SV** svp; + + // Get the #define value for the tag from the hash made at boot-up + svp = hv_fetch(tag2num_priv, (char *)tag, strlen(tag), FALSE); + if (! (svp && SvOK(*svp) && SvIOK(*svp))) + // Later we may need to set some sort of error message + return 0; + + return (SvIV(*svp)); +} + +const char* num2tag(int num) +{ + SV** svp; + STRLEN na; + char str_num[8]; + SV* tmp; + + Zero(str_num, 1, 8); + snprintf(str_num, 8, "%d", num); + svp = hv_fetch(num2tag_priv, str_num, strlen(str_num), FALSE); + if (! (svp && SvPOK(*svp))) + return Nullch; + + return (SvPV(*svp, na)); +} + +char* rpm_GetOsName(void) +{ + char* os_name; + int os_val; + + rpmGetOsInfo((const char **)&os_name, &os_val); + return os_name; +} + +char* rpm_GetArchName(void) +{ + char* arch_name; + int arch_val; + + rpmGetArchInfo((const char **)&arch_name, &arch_val); + 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) -void rpm_catch_errors_SV(void) +static void rpm_catch_errors(void) { - SV* errSV; int error_code; char* error_string; error_code = rpmErrorCode(); error_string = rpmErrorString(); - errSV = perl_get_sv("RPM::err", GV_ADD|GV_ADDMULTI); // Set the string part, first sv_setsv(errSV, newSVpv(error_string, strlen(error_string))); @@ -59,15 +106,34 @@ void rpm_catch_errors_SV(void) // Doing that didn't erase the PV part, but it cleared the flag: SvPOK_on(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 make available an easy way to clear both sides of $RPM::err -void rpm_clear_errors_SV(void) +void clear_errors(void) { - SV* errSV; - - errSV = perl_get_sv("RPM::err", GV_ADD|GV_ADDMULTI); sv_setsv(errSV, newSVpv("", 0)); sv_setiv(errSV, 0); SvPOK_on(errSV); @@ -75,43 +141,83 @@ void rpm_clear_errors_SV(void) return; } -int tag2num(const char* tag) +SV* set_error_callback(SV* newcb) { - SV** svp; + CV* oldcb; - // Get the #define value for the tag from the hash made at boot-up - svp = hv_fetch(tag2num_priv, (char *)tag, strlen(tag), FALSE); - if (! (svp && SvOK(*svp) && SvIOK(*svp))) - // Later we may need to set some sort of error message - return 0; + oldcb = err_callback; - return (SvIV(*svp)); + 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; + STRLEN len; + + sv_name = SvPV(newcb, len); + 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 (SV *)oldcb; } -const char* num2tag(int num) +void rpm_error(int code, const char* message) { - SV** svp; - STRLEN na; - char str_num[8]; - SV* tmp; + rpmError(code, (char *)message); +} - Zero(str_num, 1, 8); - snprintf(str_num, 8, "%d", num); - svp = hv_fetch(num2tag_priv, str_num, strlen(str_num), FALSE); - if (! (svp && SvPOK(*svp))) - return Nullch; - return (SvPV(*svp, na)); -} +MODULE = RPM PACKAGE = RPM::Error -MODULE = RPM PACKAGE = RPM -PROTOTYPES: DISABLE +SV* +set_error_callback(newcb) + SV* newcb; + PROTOTYPE: $ + +void +clear_errors() + PROTOTYPE: + +void +rpm_error(code, message) + int code; + char* message; + PROTOTYPE: $$ + + +MODULE = RPM PACKAGE = RPM PREFIX = rpm_ + + +char* +rpm_GetOsName() + PROTOTYPE: + +char* +rpm_GetArchName() + PROTOTYPE: + BOOT: { SV * config_loaded; + 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))) { @@ -120,7 +226,8 @@ BOOT: } setup_tag_mappings(); - rpmErrorSetCallback(rpm_catch_errors_SV); + rpmErrorSetCallback(rpm_catch_errors); + err_callback = Null(CV *); newXS("RPM::bootstrap_Constants", boot_RPM__Constants, file); newXS("RPM::bootstrap_Header", boot_RPM__Header, file); diff --git a/Perl-RPM/typemap b/Perl-RPM/typemap index 0a592a223..35c0cb1af 100644 --- a/Perl-RPM/typemap +++ b/Perl-RPM/typemap @@ -6,6 +6,7 @@ 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 |