ALPM
view release on metacpan or search on metacpan
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include <alpm.h>
#include "types.h"
#include "cb.h"
#define alpm_croak(HND)\
croak("ALPM Error: %s", alpm_strerror(alpm_errno(HND)));
MODULE = ALPM PACKAGE = ALPM
PROTOTYPES: DISABLE
# ALPM::PackageFree is a subclass of ALPM::Package.
# ALPM::DB::Sync and ALPM::DB::Local are each subclasses of ALPM::DB.
BOOT:
av_push(get_av("ALPM::PackageFree::ISA", GV_ADD), newSVpv("ALPM::Package", 0));
av_push(get_av("ALPM::DB::Sync::ISA", GV_ADD), newSVpv("ALPM::DB", 0));
#---------------------
MODULE = ALPM PACKAGE = ALPM
ALPM_Handle
new(class, root, dbpath)
SV * class
char * root
char * dbpath
PREINIT:
alpm_errno_t err;
ALPM_Handle h;
CODE:
h = alpm_initialize(root, dbpath, &err);
if(h == NULL){
croak("ALPM Error: %s", alpm_strerror(err));
}
RETVAL = h;
OUTPUT:
RETVAL
void
DESTROY(self)
ALPM_Handle self;
PREINIT:
int ret;
CODE:
ret = alpm_release(self);
if(ret == -1){
croak("ALPM Error: failed to release ALPM handle");
}
# errno is only inside a handle, which was just released...
void
caps(class)
SV * class
PREINIT:
enum alpm_caps c;
PPCODE:
c = alpm_capabilities();
if(c & ALPM_CAPABILITY_NLS){
XPUSHs(sv_2mortal(newSVpv("nls", 0)));
const char *
version(class)
SV * class
CODE:
RETVAL = alpm_version();
OUTPUT:
RETVAL
const char *
strerror(self)
ALPM_Handle self;
CODE:
RETVAL = alpm_strerror(alpm_errno(self));
OUTPUT:
RETVAL
int
errno(self)
ALPM_Handle self
CODE:
RETVAL = alpm_errno(self);
OUTPUT:
RETVAL
ALPM_Package
find_satisfier(self, depstr, ...)
SV * self
const char * depstr
PREINIT:
alpm_list_t *pkgs;
int i;
CODE:
if(items >= 3){
siglvl = p2c_siglevel(ST(2));
}else{
siglvl = ALPM_SIG_USE_DEFAULT;
}
RETVAL = alpm_register_syncdb(self, name, siglvl);
OUTPUT:
RETVAL
negative_is_error
unregister_all(self)
ALPM_Handle self
CODE:
RETVAL = alpm_unregister_all_syncdbs(self);
OUTPUT:
RETVAL
# Packages created with load_pkgfile must be freed by the caller.
# Hence we use ALPM_PackageFree. NULL pointers are converted
# into undef by the typemap.
Fixes by Andrew Gregory. Thank you!
* Release 3.04
Bugfix for DB::groups infinite while loop.
Fixed by Andrew Gregory. Thank you!
* Release 3.03
ALPM::strerror had been typo-ed as the old ALPM::alpm_strerror in 03-Package.t.
This was preventing errors from being displayed! The package format had been
updated slightly, preventing the custom built packages from generating and
loading properly.
Reported by Stefan Majewsky. Thank you!
* Release 3.02
** Bugfix for find_satisfier and find_dbs_satisfier.
These two functions were causing crashes because of my misuse of a macro
libalpm's many API changes.
** ALPM "handle" objects.
The ALPM class now creates objects when an instance of ALPM is
initialized. In libalpm these are called handles. Here they are simply
objects. You will have to change every class method (ALPM->foo) to use
an ALPM object method instead ($alpm->foo). Luckily I decided to use
class methods years ago so this will be less painful.
*** ALPM errors are stored inside handles.
This makes things more difficult for me. Given an ALPM::DB object, if you
call a method on that object and the method fails, I cannot croak an error
message internally because the ALPM handle is not available.
** ALPM::Group is no longer a class.
Packages groups are now simply lists of packages. When you lookup one
specific group then a list is returned. When querying every single
group (i.e. with ALPM::DB's groups method) a list of name/value pairs
is returned to store it into a hash.
* Release 2.01
** Fix tests to work with custom PKGEXT :BUGFIX:
Tests were failing to work when using a different PKGEXT.
** load_pkgfile error changes to croak instead of die :BUGFIX:
A minor problem I found.
* Release 2.00
** Upgrade for Pacman 3.5
Converted to the new libalpm that is distributed with pacman 3.5.
*** alpm_db_register_local removed
You don't have to call ALPM->register() to register the local DB.
** New Changelog Format
Ditched the old GNU-style ChangeLog format for an org-mode file. Old
ChangeLog entries are at the end of the file...
* Previous Releases
2011-03-05 Justin Davis <juster@cpan.org>
* RELEASE (1.03)
* t: Fix many tests that rely on English language error messages.
* lib/ALPM/LoadConfig.pm (_make_parser): Change the pacman.conf
parser to properly recognize fields which are only field names.
"= <value>" does not necessary follow them.
2011-03-04 Justin Davis <juster@cpan.org>
* RELEASE (1.02)
* lib/ALPM/LoadConfig.pm: Fix bug where config file repos could
* Makefile.PL: "make clean" will now delete the test repository
share directories (t/repos/share) and the test root
directory (t/root) automatically.
2010-01-04 Justin Davis <jrcd83@gmail.com>
* 0.5 (RELEASE)
* lib/ALPM/LoadConfig.pm (_make_parser): Tweaked regex to accept empty values.
Removed error when an unknown field name is given.
* lib/ALPM.pm: Added ability to set usedelta option, which was missing.
* Makefile.PL: Added repository URL to the META.yml.
* t/07-TiedOptions.t: Hides the warning for the last test using $SIG{__WARN__}.
* t/04-FakeRepos.t (create_repos): Fixed a bug where I must use
the --asroot option when running makepkg inside makepkg, because
of fakeroot.
extern SV *cb_dl_sub;
extern SV *cb_totaldl_sub;
extern SV *cb_fetch_sub;
/* transactions */
extern SV *cb_trans_event_sub;
extern SV *cb_trans_conv_sub;
extern SV *cb_trans_progress_sub;
/* String constants to use for log levels (instead of bitflags) */
extern const char * log_lvl_error;
extern const char * log_lvl_warning;
extern const char * log_lvl_debug;
extern const char * log_lvl_function;
extern const char * log_lvl_unknown;
/* CALLBACKS ****************************************************************/
#define DEF_SET_CALLBACK( CBTYPE ) \
if ( ! SvOK(callback) && cb_ ## CBTYPE ## _sub != NULL ) { \
SvREFCNT_dec( cb_ ## CBTYPE ## _sub ); \
const char * desc,
int item_progress,
size_t total_count,
size_t total_pos );
SV * convert_packagelist ( alpm_list_t * package_list );
SV * convert_depend ( alpm_depend_t * depend );
SV * convert_depmissing ( alpm_depissing_t * depmiss );
SV * convert_conflict (alpm_conflict_t * conflict );
SV * convert_fileconflict ( alpm_fileconflict_t * fileconflict );
SV * convert_trans_errors ( alpm_list_t * errors );
#endif
{
SV * svlvl, * svmsg;
const char *str;
char buf[256];
dSP;
if(!logcb_ref) return;
/* convert log level bitflag to a string */
switch(lvl){
case ALPM_LOG_ERROR: str = "error"; break;
case ALPM_LOG_WARNING: str = "warning"; break;
case ALPM_LOG_DEBUG: str = "debug"; break;
case ALPM_LOG_FUNCTION: str = "function"; break;
default: str = "unknown"; break;
}
ENTER;
SAVETMPS;
/* We can't use sv_vsetpvfn because it doesn't like j's: %jd or %ji, etc... */
EXTEND(SP, 3);
PUSHs(sv_2mortal(newSVpv(url, 0)));
PUSHs(sv_2mortal(newSVpv(dest, 0)));
PUSHs(sv_2mortal(newSViv(force)));
PUTBACK;
ret = 0;
if(call_sv(fetchcb_ref, G_SCALAR | G_EVAL) == 1){
svret = POPs;
if(SvTRUE(ERRSV)){
/* the callback died, return an error to libalpm */
ret = -1;
}else{
ret = (SvTRUE(svret) ? 1 : 0);
}
}
FREETMPS;
LEAVE;
return ret;
}
lib/ALPM.pod view on Meta::CPAN
use ALPM::Conf qw(/etc/pacman.conf);
## ALPM::Conf loads an object into "our" package variable.
our $alpm;
## Querying databases & packages
my $localdb = $alpm->localdb;
my $pkg = $localdb->find('perl') or die 'wtfbbq';
printf "%s %s %s %d\n", $pkg->name, $pkg->version,
$pkg->arch, $pkg->size;
my $extradb = $alpm->register('extra') or die $alpm->strerror;
$extradb->add_mirror('ftp://ftp.archlinux.org/extra/os/i686')
or die $alpm->strerror;
$extradb->update or die $alpm->strerror;
my @perlpkgs = $extradb->search('perl');
printf "%d perl packages found.\n", scalar @perlpkgs;
## libalpm's version comparison function. (a classy method)
my $cmp = ALPM->vercmp('0.01', '0.02');
if($cmp == -1){
print "less than\n";
}elsif($cmp == 0){
print "equal\n";
}elsif($cmp == 1){
lib/ALPM.pod view on Meta::CPAN
=back
=back
=head1 ALPM OBJECT METHODS
These methods can be used with ALPM objects created from the "new" method
above. In the following methods, C<$OBJ> represents an ALPM object.
=head2 errno
$ERRNO = $OBJ->errno()
=over 4
=item C<$ERRNO>
The internal libalpm error number. If no error occurs this is zero.
=back
=head2 strerror
$ERRSTR = $OBJ->strerror()
=over 4
=item C<$ERRSTR>
The error string describing the last error that occurred. Note: the language of the error messages depends on the value of $ENV{LC_ALL}.
=back
=head2 find_satisfier
$PKG | undef = $OBJ->find_satisfier($DEPSTR, @PKGS)
=over 4
=item C<$DEPSTR>
lib/ALPM.pod view on Meta::CPAN
The url to a package file which will be downloaded to our default
package cache location.
=item C<$PATH>
The path to our package file if the download succeeds.
=item C<undef>
If the download fails. Check L</strerror>.
=back
=head2 load_pkgfile
$PKG | undef = $PM->load_pkgfile($PATH, $FULL, $SIGLEVEL);
These parameters are kind of funky but they match the I<alpm_pkg_load> function.
=over 4
lib/ALPM.pod view on Meta::CPAN
=item C<$SIGLEVEL>
Signature level hashref or the string C<"default">. See L</Signature Level>.
=item C<$PKG>
On success, an L<ALPM::Package> object.
=item C<undef>
On failure. Check L</strerror>.
=back
=head2 localdb
$DB = $OBJ->localdb()
=over 4
=item C<$DB>
lib/ALPM.pod view on Meta::CPAN
package file downloaded from the database mirror. If none is specified, then the
signature level is set to C<'default'> which is equivalent to the signature level set with
the I<set_defsiglvl> method.
=item C<$DB>
On success, an L<ALPM::DB::Sync> object.
=item C<undef>
On failure. Check L</strerror>.
=back
=head2 syncdbs
@DBS = $OBJ->syncdbs()
Retrieve a list of sync databases that have previously been registered.
=over 4
lib/ALPM.pod view on Meta::CPAN
=back
=head2 unregister_all
1 | undef = $OBJ->unregister_all()
Unregisters all sync databases. If you try to use previously registered
L<ALPM::DB::Sync> objects, they will probable cause a segfault...
Returns 1 on success or undef on error. Check L</strerror> on error.
=head1 ALPM OPTIONS
ALPM has a number of options corresponding to the
C<alpm_option_get_...> and C<alpm_option_set...> C functions in the
library. Options which take multiple values (hint: they have a plural
name) accept multiple arguments in the corresponding methods.
Similarly the same options return a list.
=head2 Read-write options
lib/ALPM.pod view on Meta::CPAN
=head3 logcb - Generic logging
The log level and message are passed to the provided code ref as
arguments.
=over 4
=item 1. level
This is one of the following strings: error, warning, debug, function, or unknown.
=item 2. message
This is the message itself.
=back
=head1 DATA TYPES
Several libalpm data types have been converted into hash references. The
lib/ALPM.pod view on Meta::CPAN
The name of a package.
=item version
A version string, which can be empty.
=item mod
A boolean operator used to compare package versions to our dependency
version, must be either an empty string (which allows any version), =, >=,
<=, >, <, or ? if an internal error occurred.
=item desc
If the dependency is optional this key gives a description of the dependency. This key does not exist on a regular dependency.
=back
=head2 Conflict
Conflicts have the following keys:
lib/ALPM.pod view on Meta::CPAN
A hashref that is identical to a dependency. See L</Dependency>.
=back
=head2 Signature Level
Signature levels describe the level of security which is required for packages files
and by databases files. Different degrees of signature checking can be used for
either type of file. The signature checking is performed after the file is downloaded
in order to verify the original packager. B<When gpg is not available an invalid argument
error will be raised from libalpm if you try to set the siglevel.>
A "siglvl" can either be the string C<"default"> or a hash reference. A value of C<"default">
can be used when registering a database to instruct libalpm to use the default siglevel
that is set by I<set_defsiglvl>. A siglvl hashref must contain a C<"pkg"> key
and a C<"db"> key. Other keys are ignored.
Possible hash values include:
=over 4
lib/ALPM.pod view on Meta::CPAN
C<"required"> options to specify that signatures from anyone are to be trusted.
Here are some example siglevels:
$alpm->set_defsiglvl({ 'pkg' => 'never', 'db' => 'never' });
$alpm->set_defsiglvl({ 'pkg' => 'optional', 'db' => 'required trustall' });
$alpm->set_defsiglvl({ 'pkg' => 'required', 'db' => 'optional' });
=head1 ERRORS
In previous version of this module, errors were thrown automatically. Since then,
errors are no longer stored in a global variable (like UNIX's errno) but are instead
stored inside of the libalpm handle structure. In order to preserve the old functionality
I will have to either store a copy of the ALPM object inside every other object or use
the internal C representation which I'm technically not supposed to know.
Whatever. I'm too lazy for either of those. What this means for you is you really really
should check for errors yourself. If a method call returns undef you should follow it
up with an "or die". Something like this:
$db->force_update or die $alpm->strerror;
This is annoying but not unlike most other perl error checking. If you find yourself
calling methods on an undefined value then an error most likely occurred.
But wait there's more! Errors are actually thrown when getting/setting options and
an error condition occurs.
=head1 SEE ALSO
=over
=item * L<ALPM::Conf>, L<ALPM::DB>, L<ALPM::Package>, L<ALPM::Transaction>
=item * L<http://projects.archlinux.org/pacman.git/> - git repository for pacman/libalpm
=item * L<http://code.toofishes.net/pacman/doc/> - libalpm doxygen docs
lib/ALPM/Conf.pm view on Meta::CPAN
my $parser = _mkparser($path, $hooks);
my $line;
open my $if, '<', $path or die "open $path: $!\n";
eval {
while(<$if>){
chomp;
$line = $_;
$parser->($_);
}
};
my $err = $@;
close $if;
if($err){
# Print the offending file and line number along with any errors...
# (This is why we use dies with newlines, for cascading error msgs)
die "$@$path:$. $line\n"
}
return;
}
## Public methods.
sub new
{
my($class, $path) = @_;
lib/ALPM/Conf.pm view on Meta::CPAN
unless($dbpath){
$dbpath = "$root/var/lib/pacman";
$dbpath =~ tr{/}{/}s;
}
}
my $alpm = ALPM->new($root, $dbpath);
_setarch($opts);
while(my ($opt, $val) = each %$opts){
# The SetOption type in typemap croaks on error, no need to check.
_setopt($alpm, $opt, $val);
}
my $usesl = grep { /signatures/ } $alpm->caps;
for my $db (@$dbs){
my($r, $sl, $mirs) = @{$db}{'name', 'siglvl', 'mirrors'};
next if(!@$mirs);
_expurls($mirs, $opts->{'arch'}, $r);
$sl = 'default' if(!$usesl);
my $x = $alpm->register($r, $sl)
or die "Failed to register $r database: " . $alpm->strerror;
$x->add_server($_) for(@$mirs);
}
return $alpm;
}
sub parse
{
my($self) = @_;
my (%opts, @dbs, $currsect, $defsiglvl);
lib/ALPM/DB/Local.pod view on Meta::CPAN
=pod
=head1 NAME
ALPM::DB::Local - Machine-local package database.
=head1 SYNOPSIS
$db = $alpm->localdb;
$pkg = $db->find('perl');
$db->set_install_reason($pkg, 'implicit') or die $alpm->strerror;
=head1 OBJECT METHODS
This is a subclass of I<ALPM::DB> and inherits all of its methods.
=head2 set_install_reason
$SUCCESS = $DB->set_install_reason($PKG, $REASON);
The installation reason records whether the package was installed
explicitly or implicitly. Packages installed as requested on the command
line are installed explicitly. Packages installed as dependencies are
installed implicitly. You can override the reason here.
=over 4
=item C<$PKG>
An I<ALPM::Package> object.
=item C<$REASON>
This must be either C<"explicit"> or C<"implicit">.
=item C<$SUCCESS>
Returns truthy on success, false on error.
=back
=head1 SEE ALSO
L<ALPM::DB>
=head1 AUTHOR
Justin Davis, C<< <juster at cpan dot org> >>
lib/ALPM/DB/Sync.pod view on Meta::CPAN
$UPDATE_STATUS = $DB->update()
$SUCCESS = $DB->force_update()
Updating the database is like pacman -Su. Forcing an update will download a new
copy of the database even if it seems that we do not need to.
=over 4
=item C<$UPDATE_STATUS>
Returns 1 on success, -1 if the update was unnecessary, or 0 on error.
=item C<SUCCESS>
Returns 1 on success or 0 on error.
=back
=head1 valid
$VALID = $DB->valid()
Perform validity checks upon the database, such as a signature check.
=head1 siglvl
lib/ALPM/DB/Sync.pod view on Meta::CPAN
$SUCCESS = $DB->unregister()
Unregister the sync database. You probably shouldn't try to use the $DB object
anymore. Right now there are no safety checks.
=over 4
=item C<$SUCCESS>
Returns 1 on success or undef on error.
=back
=head1 SEE ALSO
L<ALPM::DB>, L<ALPM>, L<ALPM::Package>
=head1 AUTHOR
Justin Davis, C<< <juster at cpan dot org> >>
--version show version
--patch=file write one patch file with changes
--copy=suffix write changed copies with suffix
--diff=program use diff program and options
--compat-version=version provide compatibility with Perl version
--cplusplus accept C++ comments
--quiet don't output anything except fatal errors
--nodiag don't show diagnostics
--nohints don't show hints
--nochanges don't suggest changes
--nofilter don't filter input files
--strip strip all script and doc functionality from
ppport.h
--list-provided list provided API
--list-unsupported list unsupported API
=head2 --cplusplus
Usually, F<ppport.h> will detect C++ style comments and
replace them with C style comments for portability reasons.
Using this option instructs F<ppport.h> to leave C++
comments untouched.
=head2 --quiet
Be quiet. Don't print anything except fatal errors.
=head2 --nodiag
Don't output any diagnostic messages. Only portability
alerts will be printed.
=head2 --nohints
Don't output any hints. Hints often contain useful portability
notes. Warnings will still be displayed.
PL_bufptr|5.011000||p
PL_compiling|5.004050||p
PL_copline|5.011000||p
PL_curcop|5.004050||p
PL_curstash|5.004050||p
PL_debstash|5.004050||p
PL_defgv|5.004050||p
PL_diehook|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
PL_errgv|5.004050||p
PL_expect|5.011000||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_last_in_gv|||n
PL_laststatval|5.005000||p
PL_lex_state|5.011000||p
PL_lex_stuff|5.011000||p
PL_linestr|5.011000||p
PL_modglobal||5.005000|n
PL_na|5.004050||pn
PTRV|5.006000||p
PUSHMARK|||
PUSH_MULTICALL||5.011000|
PUSHi|||
PUSHmortal|5.009002||p
PUSHn|||
PUSHp|||
PUSHs|||
PUSHu|5.004000||p
PUTBACK|||
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
PerlIO_context_layers||5.009004|
PerlIO_eof||5.007003|
PerlIO_error||5.007003|
PerlIO_fileno||5.007003|
PerlIO_fill||5.007003|
PerlIO_flush||5.007003|
PerlIO_get_base||5.007003|
PerlIO_get_bufsiz||5.007003|
PerlIO_get_cnt||5.007003|
PerlIO_get_ptr||5.007003|
PerlIO_read||5.007003|
PerlIO_seek||5.007003|
PerlIO_set_cnt||5.007003|
PerlIO_set_ptrcnt||5.007003|
PerlIO_setlinebuf||5.007003|
PerlIO_stderr||5.007003|
PerlIO_stdin||5.007003|
PerlIO_stdout||5.007003|
PerlIO_tell||5.007003|
PerlIO_unread||5.007003|
PerlIO_write||5.007003|
Perl_signbit||5.009005|n
PoisonFree|5.009004||p
PoisonNew|5.009004||p
PoisonWith|5.009004||p
Poison|5.008000||p
ptr_table_free||5.009005|
ptr_table_new||5.009005|
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_byte|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
re_croak2|||
re_dup_guts|||
re_intuit_start||5.009005|
re_intuit_string||5.006000|
readpipe_override|||
realloc||5.007002|n
reentrant_free|||
reentrant_init|||
reentrant_retry|||vn
reentrant_size|||
ref_array_or_hash|||
refcounted_he_chain_2hv|||
refcounted_he_fetch|||
refcounted_he_free|||
refcounted_he_new_common|||
vwarner||5.006000|
vwarn||5.006000|
wait4pid|||
warn_nocontext|||vn
warner_nocontext|||vn
warner|5.006000|5.004000|pv
warn|||v
watch|||
whichsig|||
write_no_mem|||
write_to_stderr|||
xmldump_all|||
xmldump_attr|||
xmldump_eval|||
xmldump_form|||
xmldump_indent|||v
xmldump_packsubs|||
xmldump_sub|||
xmldump_vindent|||
yyerror|||
yylex|||
yyparse|||
yywarn|||
);
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
}
my $s = $warnings != 1 ? 's' : '';
my $warn = $warnings ? " ($warnings warning$s)" : '';
info("Analysis completed$warn");
if ($file{changes}) {
if (exists $opt{copy}) {
my $newfile = "$filename$opt{copy}";
if (-e $newfile) {
error("'$newfile' already exists, refusing to write copy of '$filename'");
}
else {
local *F;
if (open F, ">$newfile") {
info("Writing copy of '$filename' with changes to '$newfile'");
print F $c;
close F;
}
else {
error("Cannot open '$newfile' for writing: $!");
}
}
}
elsif (exists $opt{patch} || $opt{changes}) {
if (exists $opt{patch}) {
unless ($patch_opened) {
if (open PATCH, ">$opt{patch}") {
$patch_opened = 1;
}
else {
error("Cannot open '$opt{patch}' for writing: $!");
delete $opt{patch};
$opt{changes} = 1;
goto fallback;
}
}
mydiff(\*PATCH, $filename, $c);
}
else {
fallback:
info("Suggested changes:");
if (!defined $diff) {
$diff = run_diff('diff -u', $file, $str);
}
if (!defined $diff) {
$diff = run_diff('diff', $file, $str);
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
sub run_diff
{
my($prog, $file, $str) = @_;
my $tmp = 'dppptemp';
$diff .= $_;
}
close F;
unlink $tmp;
return $diff;
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
$opt{quiet} and return;
$opt{diag} and print @_, "\n";
}
sub warning
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
my %given_warnings;
sub hint
{
$opt{quiet} and return;
my $func = shift;
# endif
#endif
#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
/* It is very unlikely that anyone will try to use this with Perl 6
(or greater), but who knows.
*/
#if PERL_REVISION != 5
# error ppport.h only works with Perl version 5
#endif /* PERL_REVISION != 5 */
#ifndef dTHR
# define dTHR dNOOP
#endif
#ifndef dTHX
# define dTHX dNOOP
#endif
#ifndef dTHXa
# define dTHXa(x) dNOOP
#ifndef isXDIGIT
# define isXDIGIT(c) isxdigit(c)
#endif
#else
# if (PERL_BCDVERSION < 0x5010000)
/* Hint: isPRINT
* The implementation in older perl versions includes all of the
* isSPACE() characters, which is wrong. The version provided by
* Devel::PPPort always overrides a present buggy version.
*/
# undef isPRINT
# endif
#ifndef isALNUMC
# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
#endif
#ifndef isASCII
# define isASCII(c) ((c) <= 127)
#endif
# define PL_bufptr bufptr
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_debstash debstash
# define PL_defgv defgv
# define PL_diehook diehook
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_errgv errgv
# define PL_expect expect
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_laststatval laststatval
# define PL_lex_state lex_state
# define PL_lex_stuff lex_stuff
# define PL_linestr linestr
# define PL_na na
# define PL_perl_destruct_level perl_destruct_level
# define PL_perldb perldb
# else
# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
(flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
# endif
#endif
/* Replace perl_eval_pv with eval_pv */
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
SV*
DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
PUSHMARK(sp);
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
SPAGAIN;
sv = POPs;
PUTBACK;
if (croak_on_error && SvTRUE(GvSV(errgv)))
croak(SvPVx(GvSV(errgv), na));
return sv;
}
#endif
#endif
#ifndef vload_module
#if defined(NEED_vload_module)
static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
#ifndef ckWARN
# ifdef G_WARN_ON
# define ckWARN(a) (PL_dowarn & G_WARN_ON)
# else
# define ckWARN(a) PL_dowarn
# endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
#if defined(NEED_warner)
static void DPPP_(my_warner)(U32 err, const char *pat, ...);
static
#else
extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
#endif
#define Perl_warner DPPP_(my_warner)
#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
void
DPPP_(my_warner)(U32 err, const char *pat, ...)
{
SV *sv;
va_list args;
PERL_UNUSED_ARG(err);
va_start(args, pat);
sv = vnewSVpvf(pat, &args);
va_end(args);
sv_2mortal(sv);
warn("%s", SvPV_nolen(sv));
}
#define warner Perl_warner
my $dbname = shift;
my $db = $alpm->db($dbname);
is $db->name, $dbname, 'dbname matches db() arg';
checkpkgs($db, @_);
}
$db = $alpm->localdb;
is $db->name, 'local';
## Make sure DBs are synced.
$_->update or die $alpm->strerror for($alpm->syncdbs);
checkdb('simpletest', qw/foo bar/);
checkdb('upgradetest', qw/foo replacebaz/);
## Check that register siglevel defaults to 'default' when not provided.
$db = $alpm->register('empty') or die 'register failed';
## Due to libalpm trickery, if the db's siglevel is set to default, then the siglevel
## that is retrieved is a copy of the handle's default siglevel.
$siglvl = $alpm->get_defsiglvl;
t/03-Package.t view on Meta::CPAN
use Test::More;
use ALPM::Conf 't/test.conf';
sub pkgpath
{
my($dbname, $pkgname) = @_;
$db = $alpm->db($dbname);
$db->update or die $alpm->err;
my($url) = $db->get_servers;
$pkg = $db->find($pkgname) or die "$dbname/$pkgname package is missing";
$url .= q{/} . $pkg->filename;
print "$url\n";
if(($url =~ s{^file://}{}) != 1){
die 'package files are not locally hosted as expected';
}
return $url;
}
$msg = 'load the simpletest/foo package file';
$pkg = $alpm->load_pkgfile(pkgpath('simpletest', 'foo'), 1, 'default');
if($pkg){
pass $msg;
}else{
fail $msg;
die $alpm->strerror;
}
my @methnames = qw{ requiredby name version desc
url builddate installdate packager
arch arch size isize reason
licenses groups depends optdepends
conflicts provides deltas replaces
files backup };
for my $mname (@methnames) {
t/05-Callbacks.t view on Meta::CPAN
use Test::More;
use ALPM::Conf 't/test.conf';
ok !defined $alpm->get_logcb;
$cb = sub { print "LOG: @_" };
die 'internal error' unless(ref($cb) eq 'CODE');
$alpm->set_logcb($cb);
$tmp = $alpm->get_logcb($cb);
is ref($tmp), 'CODE';
ok $tmp eq $cb;
$alpm->set_logcb(undef);
ok !defined $alpm->get_logcb;
done_testing;
t/repos/package.pl view on Meta::CPAN
$pi->{'packager'} = [ 'ALPM Module' ];
return;
}
sub remkdir
{
my($d) = @_;
if(-d $d){
system 'rm' => ('-r', $d);
if($?){
printf STDERR "$PROG: rm -r $d failed: error code %d\n", $? >> 8;
exit 1;
}
}
unless(mkdir $d){
print STDERR "$PROG: mkdir $d failed: $!\n";
exit 1;
}
return;
}
TYPEMAP
SetOption T_SETOPT
IntOption T_INTOPT
StringOption T_STROPT
# This should really be called zero_is_success...
negative_is_error I_NEG_IS_ERROR
ALPM_Handle T_ALPM_HANDLE
ALPM_DB T_ALPM_DB
ALPM_LocalDB T_ALPM_LOCALDB
ALPM_SyncDB T_ALPM_SYNCDB
ALPM_Package T_ALPM_PACKAGE
ALPM_PackageFree T_ALPM_PACKAGEFREE
ALPM_FileList T_ALPM_FILELIST
ALPM_SigLevel T_SIGLEVEL
ALPM_Origin T_ORIGIN
ALPM_Validity T_VALIDITY
#--------------------
# INPUT # Perl ==> C
#--------------------
INPUT
T_ALPM_HANDLE
if(sv_derived_from($arg, \"ALPM\")){
$var = INT2PTR($type, SvIV((SV *)SvRV($arg)));
}else{
croak(\"error: expected an ALPM object\");
}
T_ALPM_DB
if(sv_derived_from($arg, \"ALPM::DB\")){
IV tmp = SvIV((SV*)SvRV($arg));
$var = INT2PTR($type, tmp);
}else{
croak(\"error: expected an ALPM::DB object\");
}
T_ALPM_LOCALDB
if(sv_derived_from($arg, \"ALPM::DB::Local\")){
IV tmp = SvIV((SV*)SvRV($arg));
$var = INT2PTR($type, tmp);
}else{
croak(\"error: expected an ALPM::DB::Local object\");
}
T_ALPM_SYNCDB
if(sv_derived_from($arg, \"ALPM::DB::Sync\")){
IV tmp = SvIV((SV*)SvRV($arg));
$var = INT2PTR($type, tmp);
}else{
croak(\"error: expected an ALPM::DB::Sync object\");
}
T_ALPM_PACKAGE
if(sv_derived_from($arg, \"ALPM::Package\")){
$var = INT2PTR($type, SvIV((SV *)SvRV($arg)));
}else{
croak(\"error: expected an ALPM::Package object\");
}
T_ALPM_PACKAGEFREE
if(sv_derived_from($arg, \"ALPM::PackageFree\")){
IV tmp = SvIV((SV*)SvRV($arg));
$var = INT2PTR($type,tmp);
}else{
croak(\"error: expected an ALPM::PackageFree object\");
}
T_SIGLEVEL
$var = p2c_siglevel($arg);
T_DEPEND
$var = p2c_depend($arg);
T_PKGREASON
$var = p2c_pkgreason($arg);
#---------------------
# OUTPUT # C ==> Perl
#---------------------
OUTPUT
# The handle should never be NULL. This is the only error condition
# but hopefully doesn't affect us. However, the string is sometimes NULL
# so we should convert it to undef.
T_STROPT
if($var == NULL){
$arg = &PL_sv_undef;
}else{
$arg = newSVpv($var, 0);
}
T_SETOPT
alpm_croak(self);
}else{
$arg = newSViv($var);
}
I_NEG_IS_ERROR
$arg = ($var == 0 ? &PL_sv_yes : &PL_sv_no);
T_ALPM_HANDLE
if($var == NULL){
croak(\"error: ALPM handle is NULL\");
}else{
sv_setref_pv($arg, \"ALPM\", (void *)$var);
}
T_ALPM_DB
if($var == NULL){
$arg = &PL_sv_undef;
}else{
$arg = c2p_db($var);
}
#ifndef _ALPMXS_TYPES
#define _ALPMXS_TYPES
/* TYPEDEFS */
/* Used in typemap and xs/Options.xs. */
typedef int SetOption;
typedef int IntOption;
typedef char * StringOption;
typedef int negative_is_error;
typedef alpm_handle_t * ALPM_Handle;
typedef alpm_db_t * ALPM_DB;
typedef alpm_db_t * ALPM_LocalDB;
typedef alpm_db_t * ALPM_SyncDB;
typedef alpm_pkg_t * ALPM_Package;
typedef alpm_pkg_t * ALPM_PackageFree;
typedef alpm_siglevel_t ALPM_SigLevel;
typedef alpm_pkgfrom_t ALPM_Origin;
typedef alpm_pkgvalidation_t ALPM_Validity;
MODULE = ALPM PACKAGE = ALPM::DB
void
pkgs(db)
ALPM_DB db
PREINIT:
alpm_list_t *pkgs;
PPCODE:
pkgs = alpm_db_get_pkgcache(db);
# If pkgs is NULL, we can't report the error because errno is in the handle object.
LIST2STACK(pkgs, c2p_pkg);
# groups returns a list of pairs. Each pair is a group name followed by
# an array ref of packages belonging to the group.
void
groups(db)
ALPM_DB db
PREINIT:
alpm_list_t *grps;
ZAPLIST(terms, free);
LIST2STACK(fnd, c2p_pkg);
alpm_list_free(L);
#-----------------------------
# PUBLIC LOCAL DATABASE METHODS
#-----------------------------
MODULE = ALPM PACKAGE = ALPM::DB::Local
negative_is_error
set_install_reason(self, pkg, rsn)
ALPM_LocalDB self
ALPM_Package pkg
alpm_pkgreason_t rsn
CODE:
RETVAL = alpm_pkg_set_reason(pkg, rsn);
OUTPUT:
RETVAL
#-----------------------------
ret = alpm_db_update(0, db);
switch(ret){
case 0: RETVAL = 1; break;
case 1: RETVAL = -1; break; /* DB did not need to be updated */
case -1: RETVAL = 0; break;
default: croak("Unrecognized return value of alpm_db_update");
}
OUTPUT:
RETVAL
negative_is_error
force_update(db)
ALPM_SyncDB db
CODE:
RETVAL = alpm_db_update(1, db);
OUTPUT:
RETVAL
ALPM_SigLevel
siglvl(db)
ALPM_SyncDB db
CODE:
RETVAL = alpm_db_get_siglevel(db);
OUTPUT:
RETVAL
MODULE = ALPM PACKAGE = ALPM::DB::Sync PREFIX = alpm_db_
negative_is_error
alpm_db_unregister(self)
ALPM_SyncDB self
negative_is_error
alpm_db_add_server(self, url)
ALPM_SyncDB self
const char *url
negative_is_error
alpm_db_remove_server(self, url)
ALPM_SyncDB self
const char *url
void alpm_db_get_servers(self)
ALPM_SyncDB self
PREINIT:
alpm_list_t *srvs;
PPCODE:
srvs = alpm_db_get_servers(self);
LIST2STACK(srvs, c2p_str);
negative_is_error
alpm_db_set_servers(self, ...)
ALPM_SyncDB self
PREINIT:
alpm_list_t *L;
int i;
CODE:
i = 1;
STACK2LIST(i, L, p2c_str);
RETVAL = alpm_db_set_servers(self, L);
OUTPUT:
xs/Options.xs view on Meta::CPAN
# Ditto.
void
syncdbs(self)
ALPM_Handle self
PREINIT:
alpm_list_t *lst;
PPCODE:
lst = alpm_get_syncdbs(self);
if(lst == NULL && alpm_errno(self)) alpm_croak(self);
LIST2STACK(lst, c2p_syncdb);
ALPM_SigLevel
get_defsiglvl(self)
ALPM_Handle self
CODE:
RETVAL = alpm_option_get_default_siglevel(self);
OUTPUT:
RETVAL
xs/Package.xs view on Meta::CPAN
SV *changelog_txt;
CODE:
changelog_txt = newSVpv("", 0);
RETVAL = changelog_txt;
fp = alpm_pkg_changelog_open(pkg);
if(fp){
while(1){
bytes_read = alpm_pkg_changelog_read((void *)buffer, 128,
pkg, fp);
/*fprintf(stderr,"DEBUG: read %d bytes of changelog\n", */
/* bytes_read); */
if(bytes_read == 0) break;
sv_catpvn(changelog_txt, buffer, bytes_read);
}
alpm_pkg_changelog_close(pkg, fp);
}
OUTPUT:
RETVAL
MODULE=ALPM PACKAGE=ALPM::Package PREFIX=alpm_pkg_compute_
StringListFree
pkg_compute(pkg)
ALPM_Package pkg
INTERFACE:
alpm_pkg_compute_requiredby
alpm_pkg_compute_optionalfor
MODULE=ALPM PACKAGE=ALPM::Package PREFIX=alpm_pkg_
negative_is_error
alpm_pkg_checkmd5sum(pkg)
ALPM_Package pkg
int
alpm_pkg_has_scriptlet(pkg)
ALPM_Package pkg
off_t
alpm_pkg_download_size(newpkg)
ALPM_Package newpkg
( run in 0.741 second using v1.01-cache-2.11-cpan-49f99fa48dc )