diff options
author | nanardon <nanardon@971eb68f-4bfb-0310-8326-d2484c010a4c> | 2005-10-04 04:08:46 +0000 |
---|---|---|
committer | nanardon <nanardon@971eb68f-4bfb-0310-8326-d2484c010a4c> | 2005-10-04 04:08:46 +0000 |
commit | 9e2966a33f9148fdc8ef81783bab1fe18e87bd34 (patch) | |
tree | 7497629483bdfca79e64991306f251dfdc9bdafb /RPM4/lib | |
parent | 588601a22c421404c9db24e0a47330d2186977f9 (diff) | |
download | perl-RPM4-9e2966a33f9148fdc8ef81783bab1fe18e87bd34.tar perl-RPM4-9e2966a33f9148fdc8ef81783bab1fe18e87bd34.tar.gz perl-RPM4-9e2966a33f9148fdc8ef81783bab1fe18e87bd34.tar.bz2 perl-RPM4-9e2966a33f9148fdc8ef81783bab1fe18e87bd34.tar.xz perl-RPM4-9e2966a33f9148fdc8ef81783bab1fe18e87bd34.zip |
- move to trunk
git-svn-id: svn+ssh://haiku.zarb.org/home/projects/rpm4/svn/trunk@36 971eb68f-4bfb-0310-8326-d2484c010a4c
Diffstat (limited to 'RPM4/lib')
-rw-r--r-- | RPM4/lib/RPM4.pm | 422 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Header.pm | 335 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Header/Changelogs.pm | 73 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Header/Checks.pm | 98 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Header/Dependencies.pm | 118 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Header/Files.pm | 61 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Index.pm | 163 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Media.pm | 193 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Spec.pm | 195 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Transaction.pm | 195 | ||||
-rw-r--r-- | RPM4/lib/RPM4/Transaction/Problems.pm | 115 |
11 files changed, 1968 insertions, 0 deletions
diff --git a/RPM4/lib/RPM4.pm b/RPM4/lib/RPM4.pm new file mode 100644 index 0000000..beac297 --- /dev/null +++ b/RPM4/lib/RPM4.pm @@ -0,0 +1,422 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +package RPM4; + +use strict; +use warnings; + +use DynaLoader; +use Exporter; + +use RPM4::Header; +use RPM4::Transaction; +use RPM4::Header::Dependencies; +use RPM4::Header::Files; +use RPM4::Spec; + +our $VERSION = '0.08'; +our @ISA = qw(DynaLoader Exporter); +our @EXPORT = qw(moduleinfo + readconfig querytag tagName tagValue expand rpmvercmp + stream2header rpm2header + installsrpm + setverbosity setlogcallback format_rpmpb + rpmresign + newdb parserpms); +our %EXPORT_TAGS = ( + rpmlib => [qw(getosname getarchname dumprc dumpmacros rpmvercmp setverbosity setlogcallback + rpmlog)], + macros => [qw(add_macros del_macros loadmacrosfile resetmacros)], + build => [qw(headernew)], + rpmdb => [qw(rpmdbverify rpmdbrebuild)], +); + +bootstrap RPM4; + +# I18N: +sub N { + my ($msg, @args) = @_; + sprintf($msg, @args) +} + +sub compare_evr { + my ($ae, $av, $ar) = $_[0] =~ /^(?:([^:]*):)?([^-]*)(?:-(.*))?$/; + my ($be, $bv, $br) = $_[1] =~ /^(?:([^:]*):)?([^-]*)(?:-(.*))?$/; + + my $rc = 0; + if(defined($ae) && ! defined($be)) { + return 1; + } elsif(!defined($ae) && defined($be)) { + return -1; + } else { + $rc = RPM4::rpmvercmp($ae, $be) if (defined($ae) && defined($be)); + if ($rc == 0) { + $rc = RPM4::rpmvercmp($av, $bv); + if ($rc == 0) { + if(defined($ar) && !defined($br)) { + return 1; + } elsif(!defined($ar) && defined($br)) { + return -1; + } elsif (!defined($ar) && !defined($br)) { + return 0; + } else { + return RPM4::rpmvercmp($ar, $br); + } + } else { + return $rc; + } + } else { + return $rc; + } + } +} + +# parse* function +# callback => function +# ( +# header => the header (undef on error) +# file => actual source +# ) +# files => [] +# flags => ?? + +sub parserpms { + my (%options) = @_; + my $db = newdb(); + $db->vsflags($options{checkrpms} ? [ "NOSIGNATURES" ] : [ qw(NOSIGNATURES NOPAYLOAD NODIGESTS) ]); + foreach my $rpm (@{$options{rpms} || []}) { + my $header = $db->rpm2header($options{path} ? "$options{path}/$rpm" : $rpm); + defined($options{callback}) and + $options{callback}->( + header => $header, + dir => $options{path} ? "$options{path}/" : "", + rpm => $rpm, + ); + } +} + +sub format_rpmpb { + my (@msgs) = @_; + my @ret; + foreach my $p (@msgs) { + $p->{pb} eq "BADARCH" and do { + push @ret, N('package %s is intended for a different architecture', $p->{pkg}); + next; + }; + $p->{pb} eq "BADOS" and do { + push @ret, N('package %s is intended for a different operating system', $p->{pkg}); + next; + }; + $p->{pb} eq "PKG_INSTALLED" and do { + push @ret, N('package %s is allready installed', $p->{pkg}); + next; + }; + $p->{pb} eq "BADRELOCATE" and do { + push @ret, N('path %s in package %s is not relocatable', $p->{path}, $p->{pkg}); + next; + }; + $p->{pb} eq "NEW_FILE_CONFLICT" and do { + push @ret, N('file %s conflicts between attempted installs of %s and %s', $p->{file}, $p->{pkg}, $p->{pkg2}); + next; + }; + $p->{pb} eq "FILE_CONFLICT" and do { + push @ret, N('file %s from install of %s conflicts with file from package %s', $p->{file}, $p->{pkg}, $p->{pkg2}); + next; + }; + $p->{pb} eq "OLDPACKAGE" and do { + push @ret, N('package %s (which is newer than %s) is already installed', $p->{pkg2}, $p->{pkg}); + next; + }; + $p->{pb} eq "DISKSPACE" and do { + push @ret, N('installing package %s needs %sB on the %s filesystem', $p->{pkg}, + ($p->{size} > 1024 * 1024 + ? ($p->{size} + 1024 * 1024 - 1) / (1024 * 1024) + : ($p->{size} + 1023) / 1024 ) . + ($p->{size} > 1024 * 1024 ? 'M' : 'K'), + $p->{filesystem}); + next; + }; + $p->{pb} eq "DISKNODES" and do { + push @ret, N('installing package %s needs %ld inodes on the %s filesystem', $p->{pkg}, $p->{nodes}, $p->{filesystem}); + next; + }; + $p->{pb} eq "BADPRETRANS" and do { + push @ret, N('package %s pre-transaction syscall(s): %s failed: %s', $p->{pkg}, $p->{'syscall'}, $p->{error}); + next; + }; + $p->{pb} eq "REQUIRES" and do { + push @ret, N('%s is needed by %s%s', $p->{pkg2}, + defined($p->{installed}) ? N("(installed) ") : "", + $p->{pkg}); + next; + }; + $p->{pb} eq "CONFLICT" and do { + push @ret, N('%s conflicts with %s%s', $p->{pkg2}, + defined($p->{val2}) ? N("(installed) ") : "", + $p->{pkg}); + next; + }; + }; + @ret +} + +########################## +# Alias for compatiblity # +########################## + +sub specnew { + newspec(@_); +} + +1; + +__END__ + +=head1 NAME + +RPM4 - perl module to handle hdlist and synthesis files + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +This module allow to use API functions from rpmlib, directly or trough +perl objects. + +=head1 FUNCTIONS + +=head2 readconfig($rpmrc, $target) + +Force rpmlib to re-read configuration files. If defined, $rpmrc is read. +If $target is defined, rpmlib will read config for this target. $target has +the form "CPU-VENDOR-OS". + + readconfig(); # Reread default configuration + readconfig(undef, "i386-mandrake-linux"); # Read configuration for i386 + +=head2 setverbosity($level) + +Set the rpmlib verbosity level. $level can be an integer (0 to 7) or a +verbosity level name. + + - EMERG (0) + - ALERT (1) + - CRIT (2) + - ERR (3) + - WARNING (4) + - NOTICE (5) + - INFO (6) + - DEBUG (7) + +=head2 setlogcallback(sub {}) + +Set a perl callback code for rpm logging/output system. When the callback is +set, rpm lets your code print error/information messages. The parameter passed +to the callback is a hash with log value: + C<locode> => the rpm log code (integer), + C<priority> => priority of the message (0 to 7), + C<msg> => the formated string message. + +To unset the callback function, passed an undef value as code reference. + +Ex: + setlogcallback( sub { + my %log = @_; + print "$log{priority}: $log{msg}\n"; + }); + +=head2 setlogfile(filename) + +Redirect all rpm message into this file. Data will be append to the end of the +file, the file is created if it don't already exists. The old loging file is close. + +To unset (and close) a pending loging file, passed an undef value. + +=head2 lastlogmsg + +Return an array about latest rpm log message information: + - rpm log code, + - rpm priority (0 to 7), + - string message. + +=head2 rpmlog($codelevel, $msg) + +Send a message trougth the rpmlib logging system. + - $codelevel is either an integer value between 0 and 7, or a level code string, +see setverbosity(), + - $msg is the message to send. + +=head2 format_rpmpb(@pb) + +Some functions return an array of rpm transaction problem +(RPM4::Db->transpb()), this function return an array of human readable +string for each problem. + +=head2 querytag + +Returns a hash containing the tags known by rpmlib. The hash has the form +C< TAGNAME => tagvalue >. Note that some tags are virtual and do not have +any tag value, and that some tags are alias to already existing tags, so +they have the same value. + +=head2 tagtypevalue($tagtypename) + +Return the type value of a tag type. $tagtypename can be CHAR, INT8, INT16 +INT32, STRING, ARRAY_STRING or I18NSTRING. This return value is usefull with +RPM4::Header::addtag() function. + +=head2 tagName($tagvalue) + +Returns the tag name for a given internal value. + + tagName(1000); return "NAME". + +See: L<tagValue>. + +=head2 tagValue($tagname) + +Returns the internal tag value for C<$tagname>. + + tagValue("NAME"); return 1000. + +See: L<tagName>. + +=head2 expand($string) + +Evaluate macros contained in C<$string>, like C<rpm --eval>. + + expand("%_var") return "/var". + +=head2 add_macro("_macro value") + +Define a macro into rpmlib. The macro is defined for the whole script. Ex: +C<add_macro("_macro value")>. Note that the macro name does have the prefix +"%", to prevent rpm from evaluating it. + +=head2 del_macro("_macro") + +Delete a macro from rpmlib. Exactly the reverse of add_macro(). + +=head2 loadmacrosfile($filename) + +Read a macro configuration file and load macros defined within. +Unfortunately, the function returns nothing, even when file loading failed. + +To reset macros loaded from file you have to re-read the rpm config file +with L<readconfig>. + +=head2 resetmacros + +Reset all macros defined with add_macro() functions. + +This function does not reset macros loaded with loadmacrosfile(). + +=head2 getosname + +Returns the operating system name of current rpm configuration. +Rpmlib auto-detects the system name, but you can force rpm to use +another system name with macros or using readconfig(). + +=head2 getarchname + +Returns the arch name of current rpm configuration. +Rpmlib auto-detects the architecture, but you can force rpm to use +another architecture with macros or by using readconfig(). + +=head2 buildhost + +Returns the BuildHost name of the current system, ie the value rpm will use +to set BuilHost tag in built rpm. + +=head2 dumprc(*FILE) + +Dump rpm configuration into file handle. +Ex: + dumprc(*STDOUT); + +=head2 dumpmacros(*FILE) + +Dump rpm macros into file handle. +Ex: + dumpmacros(*STDOUT); + +=head2 rpmresign($passphrase, $rpmfile) + +Resign a rpm using user settings. C<$passphrase> is the key's gpg/pgp +pass phrase. + +Return 0 on success. + +=head2 rpmvercmp(version1, version2) + +Compare two version and return 1 if left argument is highter, -1 if +rigth argument is highter, 0 if equal. +Ex: + rpmvercmp("1.1mdk", "2.1mdk"); # return -1. + +=head2 compare_evr(version1, version2) + +COmpare two rpm version in forms [epoch:]version[-release] and return +1 if left argument is highter, -1 if rigth argument is highter, 0 if +equal. +Ex: + compare_evr("1:1-1mdk", "2-2mdk"); # return 1 + +=head2 installsrpm($filename) + +Install a source rpm and return spec file path and its cookies. +Returns undef if install is impossible. + +see L<RPM4::Spec>->new() for more information about cookies. + +=head2 rpmdbinit(rootdir, permissions) + +Create an empty rpm database located into I<%{_dbpath}> (useally /var/lib/rpm). +If set, rootdir is the root directory of system where rpm db should be +create, if set, theses permissions will be applied to files, default is 0644. + +Directory I<%{_dbpath}> should exist. + +Returns 0 on success. + +Ex: + rpmdbinit(); # Create rpm database on the system + rpmdbinit("/chroot"); # Create rpm database for system located into /chroot. + +=head2 rpmdbverify($rootdir) + +Verify rpm database located into I<%{_dbpath}> (useally /var/lib/rpm). +If set, $rootdir is root directory of system to check. + +Returns 0 on success. + +=head2 rpmdbrebuild($rootdir) + +Rebuild the rpm database located into I<%{_dbpath}> (useally /var/lib/rpm). +If set, $rootdir is the root directory of system. + +Returns 0 on success. + +=head1 SEE ALSO + +L<rpm(8)>, + +This aims at replacing part of the functionality provided by URPM. + +=cut diff --git a/RPM4/lib/RPM4/Header.pm b/RPM4/lib/RPM4/Header.pm new file mode 100644 index 0000000..21f80e2 --- /dev/null +++ b/RPM4/lib/RPM4/Header.pm @@ -0,0 +1,335 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +package RPM4::Header; + +use strict; +use warnings; +use vars qw($AUTOLOAD); + +use RPM4; +use Digest::SHA1; +use Carp; + +sub new { + my ($class, $arg) = @_; + + if ($arg) { + if (ref $arg eq 'GLOB') { + return RPM4::stream2header($arg); + } elsif (-f $arg) { + return RPM4::rpm2header($arg); + } else { + croak("Invalid argument $arg"); + } + } else { + return RPM4::headernew(); + } +} + +# proxify calls to $header->tag() +sub AUTOLOAD { + my ($header) = @_; + + my $tag = $AUTOLOAD; + $tag =~ s/.*:://; + return $header->tag($tag); +} + +sub writesynthesis { + my ($header, $handle, $filestoprovides) = @_; + $handle ||= *STDOUT; + + my $sinfo = $header->synthesisinfo($filestoprovides); + + foreach my $deptag (qw(provide conflict obsolete require)) { + printf($handle '@%ss@%s'."\n", + $deptag, + join('@', @{$sinfo->{$deptag}})) if (@{$sinfo->{$deptag} || []}); + } + + printf($handle '@summary@%s'. "\n", + $sinfo->{summary}, + ); + printf($handle '@info@%s@%d@%d@%s'."\n", + $sinfo->{fullname}, + $sinfo->{epoch}, + $sinfo->{size}, + $sinfo->{group}, + ); + return 1; +} + +sub synthesisinfo { + my ($header, $filestoprovides) = @_; + my $synthinfo = { + fullname => scalar($header->fullname()), + summary => $header->tag(1004), + epoch => $header->tag(1003) || 0, + size => $header->tag(1009), + group => $header->tag(1016), + os => $header->tag('OS'), + hdrid => pack("H*",$header->tag('HDRID')), + }; + + + my @pkgfiles; + if (my $files = $header->files()) { + $files->init(); + while($files->next() >= 0) { + my $f = $files->filename(); + foreach(@{$filestoprovides}) { + $_ eq $f and do { + push @pkgfiles, "$f"; + last; + }; + } + } + } + foreach my $deptag (qw(provide conflict obsolete require)) { + my @deps; + $deptag eq 'provide' and push(@deps, @pkgfiles); + if (my $dep = $header->dep(uc($deptag . "name")) || undef) { + $dep->init(); + while ($dep->next() >= 0) { + ($dep->flags() & (1 << 24)) and next; + my @d = $dep->info(); + #$d[1] =~ /^rpmlib\(\S*\)$/ and next; + push(@deps, sprintf( + "%s%s%s", + "$d[1]", + ($dep->flags() & RPM4::flagvalue('sense', [ 'PREREQ' ])) ? '[*]' : '', + $d[2] ? '[' . ($d[2] eq '=' ? '==' : $d[2]) . " $d[3]\]" : '' )); + } + } + + { my %uniq; @uniq{@deps} = (); @deps = keys(%uniq); } + push(@{$synthinfo->{$deptag}}, @deps) if(@deps); + } + + $synthinfo; +} + +# return an array of required files +sub requiredfiles { + my ($header) = @_; + grep { m:^/: } $header->tag(1049); +} + +# is this usefull +# @keeptags can/should be reworks +sub buildlight { + my ($header, $hinfo) = @_; + + { + my @n = $hinfo->{fullname} =~ m/^(.*)-([^-]*)-([^-]*)\.([^.]*)/; + + $header->addtag(1000, 6, $n[0]); # Name + $header->addtag(1001, 6, $n[1]); # Version + $header->addtag(1002, 6, $n[2]); # Release + if ($n[3] eq 'src') { + $header->addtag(1022, 6, RPM4::getarchname()); # Arch + } else { + $header->addtag(1022, 6, $n[3]); + $header->addtag(1044, 6, "RPM4-Fake-1-1mdk.src.rpm"); + } + } + $header->addtag(1004, 6, $hinfo->{summary}); + $header->addtag(1003, 4, $hinfo->{epoch}) if ($hinfo->{epoch}); + $header->addtag(1009, 4, $hinfo->{size}); + $header->addtag(1016, 6, $hinfo->{group}); + $header->addtag("OS", 6, $hinfo->{os} ? $hinfo->{os} : RPM4::getosname()); + + foreach my $dep (qw(provide require conflict obsolete)) { + my $deptag = $dep; $deptag = uc($deptag); + foreach my $entry (@{$hinfo->{$dep} || []}) { + my ($name, $pre, $fl, $version) = $entry =~ m/([^\[]*)(\[\*\])?(?:\[(\S*)(?:\s*(\S*))?\])?/; + $fl ||= ''; + $dep eq 'provide' && substr($name, 0, 1) eq '/' and do { + $header->addtag('OLDFILENAMES', 8, $name); + next; + }; + #print "$deptag . 'NAME', 8, $name\n"; + $header->addtag($deptag . 'NAME', 8, $name); + $header->addtag($deptag . 'FLAGS', 'INT32', RPM4::flagvalue("sense", $fl || "") | ($pre ? RPM4::flagvalue("sense", [ 'PREREQ' ]) : 0)); + $header->addtag($deptag . 'VERSION', 8, $version || ""); + } + } + + if (!$hinfo->{hdrid}) { + my $sha = Digest::SHA1->new; + + foreach my $tag ($header->listtag()) { + $sha->add(join('', $header->tag($tag))); + } + + $hinfo->{hdrid} = $sha->digest; + } + + $header->addtag("HDRID", "BIN", $hinfo->{hdrid}); +} + +sub getlight { + my ($header, $reqfiles) = @_; + my $hi = RPM4::headernew(); + $hi->buildlight($header->synthesisinfo($reqfiles)); + $hi +} + +sub osscore { + my ($header) = @_; + my $os = $header->tag("OS"); + defined $os ? RPM4::osscore($os) : 1; +} + +sub archscore { + my ($header) = @_; + $header->issrc and return 0; + my $arch = $header->tag("ARCH"); + defined($arch) ? RPM4::archscore($arch) : 1; +} + +sub is_better_than { + my ($header, $h) = @_; + + if ($header->tag(1000) eq $h->tag(1000)) { + my $c = $header->compare($h); + $c != 0 and return $c; + return 1 if $header->osscore < $h->osscore; + return 1 if $header->archscore < $h->archscore; + } elsif (my $obs = $header->dep('OBSOLETENAME')) { + $obs->init(); + while ($obs->next >= 0) { + $obs->name eq $h->tag(1000) or next; + return 1 if ($obs->matchheadername($h)); + } + } + 0; +} + +sub sourcerpmname { + $_[0]->queryformat('%|SOURCERPM?{%{SOURCERPM}}:{%{NAME}-%{VERSION}-%{RELEASE}.src.rpm}|') +} + +1; + +__END__ + +=head1 NAME + +RPM4::Header + +=head1 DESCRIPTION + +The header contains informations about a rpms, this object give methods +to manipulate its. + +=head1 METHODS + +=head2 RPM4::Header->new($item) + +Create a new C<RPM4::Header> instance from: + +=over 4 + +=item a file + +if $item is an rpm file, returns the corresponding object. + +=item a file handler + +if $item is a file handler, returns an object corresponding to the next header there. + +=item nothing + +if $item is omitted, returns an empty object. + +=back + +If data are unreadable for whatever reason, returns undef. + +=head2 RPM4::Header->write(*FILE) + +Dump header data into file handle. + +Warning: Perl modifier (like PerlIO::Gzip) won't works. + +=head2 RPM4::Header->hsize() + +Returns the on-disk size of header data, in bytes. + +=head2 RPM4::Header->copy() + +Returns a RPM4::Header object copy. + +=head2 RPM4::Header->removetag(tagid) + +Remove tag 'tagid' from header. + +=head2 RPM4::Header->addtag(tagid, tagtype, value1, value2...) + +Add a tag into the header: +- tagid is the integervalue of tag +- tagtype is an integer, it identify the tag type to add (see rpmlib headers +files). Other argument are value to put in tag. + +=head2 RPM4::Header->listtag() + +Returns a list of tag id present in header. + +=head2 RPM4::Header->hastag(tagid) + +Returns true if tag 'tagid' is present in header. + +Ex: + $header->hastag(1000); # Returns true if tag 'NAME' is present. + +=head2 RPM4::Header->tagtype(tagid) + +Returns the tagtype value of tagid. Returns 0 if tagid is not found. + +=head2 RPM4::Header->tag(tagid) + +Returns array of tag value for tag 'tagid'. + + $header->tag(1000); # return the name of rpm header. + +=head2 RPM4::Header->queryformat($query) + +Make a formated query on the header, macros in I<$query> are evaluated. +This function works like C<rpm --queryformat ...> + + $header->queryformat("%{NAME}-%{VERSION}-%{RELEASE}"); + +=head2 RPM4::Header->fullname + +In scalar context return the "name-version-version.arch" of package. +In array context return (name, version, release, arch) of package. + +=head2 RPM4::Header->issrc() + +Returns true if package is a source package. + +=head2 RPM4::Header->compare(header) + +Compare the header to another, return 1 if the object is higher, -1 if +header passed as argument is better, 0 if update is not possible. + +=head1 SEE ALSO + +L<RPM4> diff --git a/RPM4/lib/RPM4/Header/Changelogs.pm b/RPM4/lib/RPM4/Header/Changelogs.pm new file mode 100644 index 0000000..be614c0 --- /dev/null +++ b/RPM4/lib/RPM4/Header/Changelogs.pm @@ -0,0 +1,73 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +package RPM4::Header::Changelogs; + +sub new { + my ($class, $header) = @_; + + my $changelogs = { + changelogtext => [ $header->tag("changelogtext") ], + changelogname => [ $header->tag("changelogname") ], + changelogtime => [ $header->tag("changelogtime") ], + _counter => -1, + }; + bless($changelogs, $class); +} + +sub init { + my ($self) = @_; + $self->{_counter} = -1; +} + +sub hasnext { + my ($self) = @_; + $self->{_counter}++; + return $self->{_counter} <= $#{$self->{changelogname}}; +} + +sub text { + my ($self) = @_; + return ${$self->{changelogtext}}[$self->{_counter}]; +} + +sub name { + my ($self) = @_; + return ${$self->{changelogname}}[$self->{_counter}]; +} + +sub time { + my ($self) = @_; + return ${$self->{changelogtime}}[$self->{_counter}]; +} + + +1; + +__END__ + +=head1 NAME + +Hdlist::Header::Changelogs - A set of changelogs + +=head1 METHODS + +=head1 SEE ALSO + +L<Hdlist> + diff --git a/RPM4/lib/RPM4/Header/Checks.pm b/RPM4/lib/RPM4/Header/Checks.pm new file mode 100644 index 0000000..0a4b0d7 --- /dev/null +++ b/RPM4/lib/RPM4/Header/Checks.pm @@ -0,0 +1,98 @@ +# $Id$ + +package RPM4::Header::Checks; + +use strict; +use warnings; + +my @tagstocheck = ( + { + tag => 'NAME', + type => 'STRING', + count => 1, + mandatory => 1, + }, + { + tag => 'VERSION', + type => 'STRING', + count => 1, + mandatory => 1, + }, + { + tag => 'RELEASE', + type => 'STRING', + count => 1, + mandatory => 1, + }, + { tag => 'EPOCH', type => 'INT32', count => 1, }, + { + tag => 'CHANGELOGTEXT', type => 'STRING_ARRAY', + countof => [ qw(CHANGELOGNAME CHANGELOGTIME) ], + }, + { tag => 'CHANGELOGNAME', type => 'STRING_ARRAY', }, + { tag => 'CHANGELOGTIME', type => 'INT32', }, + { tag => 'PACKAGER', type => 'STRING', }, + { tag => 'DISTRIBUTION', type => 'STRING', }, + { tag => 'SUMMARY', type => 'STRING', count => 1, mandatory => 1, }, + { tag => 'DESCRIPTION', type => 'STRING', count => 1, mandatory => 1, }, + +); + +sub reporterror { + printf(@_); + print "\n"; +} + +sub check { + my ($header) = @_; + foreach my $check (@tagstocheck) { + $check->{tag} or next; # buggy check + + if (!$header->hastag($check->{tag})) { + reporterror( + "tag %s not found", + $check->{tag}, + ) if($check->{mandatory}); + } elsif (defined($check->{count})) { + my @t = $header->tag($check->{tag}); + if(scalar(@t) != $check->{count}) { + reporterror( + "Wrong count for tag %s: %d, %d is expected", + $check->{tag}, + scalar(@t), + $check->{count}, + ); + } + } + + if ($check->{countof}) { + my @t = $header->tag($check->{tag}); + foreach my $co (@{$check->{countof}}) { + my @t2 = $header->tag($co); + if (scalar(@t) != scalar(@t2)) { + reporterror( + "count of tag %s is not the same than %s, %d vs %d", + $check->{tag}, + $co, + scalar(@t), + scalar(@t2), + ); + } + } + } + + $header->hastag($check->{tag}) or next; + + if ($check->{type}) { + if ($header->tagtype($check->{tag}) != RPM4::tagtypevalue($check->{type})) { + reporterror( + "Wrong tagtype for tag %s: %d, %d is expected", + $check->{tag}, + $header->tagtype($check->{tag}), + RPM4::tagtypevalue($check->{type}) + ); + } + } + } +} + diff --git a/RPM4/lib/RPM4/Header/Dependencies.pm b/RPM4/lib/RPM4/Header/Dependencies.pm new file mode 100644 index 0000000..f9a0198 --- /dev/null +++ b/RPM4/lib/RPM4/Header/Dependencies.pm @@ -0,0 +1,118 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +package RPM4::Header::Dependencies; + +sub new { + my ($class, $deptag, $initdep, @depdesc) = @_; + print "$deptag, $initdep\n"; + my $dep = RPM4::Header::Dependencies->newsingle($deptag, @$initdep) or return; + foreach (@depdesc) { + print "$_\n"; + $dep->add(@$_); + } + return $dep; +} + +1; + +__END__ + +=head1 NAME + +Hdlist::Header::Dependencies - A set of dependencies + +=head1 METHODS + +=head2 Hdlist::Header::Dependencies->new($tagtype, $dep1, [$dep2, ...]) + +Create a new arbitrary dependencies set. +$tagtype is the rpm tag {PROVIDE/REQUIRE/CONFLICT/OBSOLETE/TRIGGER}NAME. + +Next arguments are array ref for each dependancy to add in the dependencies set, +in form a name and optionnaly as sense flags and a version. + +For example: + + $d = Hdlist::Header::Dependencies->new( + "REQUIRENAME" + [ "rpm" ], + [ "rpm", 2, "4.0" ], + [ "rpm", [ qw/LESS/ ], "4.0" ] + ); + +=head2 $deps->count + +Return the number of dependencies contained by this set. + +=head2 $deps->move($index) + +Move internal index to $index (0 by default). + +=head2 $deps->init + +Reset internal index and set it to -1, see L<$deps-\\>next()> + +=head2 $deps->hasnext + +Advance to next dependency in the set. +Return FALSE if no further dependency available, TRUE otherwise. + +=head2 $deps->next + +Advance to next dependency in the set. +Return -1 if no further dependency available, next index otherwise. + +=head2 $deps->color + +Return the 'color' of the current dependency in the depencies set. + +=head2 $deps->overlap($depb) + +Compare two dependency from two dependencies set and return TRUE if match. + +=head2 $deps->info + +Return information about current dependency from dependencies set. + +=head2 $deps->tag + +Return the type of the dependencies set as a rpmtag (PROVIDENAME, REQUIRENAME, +PROVIDENAME, OBSOLETENAME of TRIGGERNAME). + +=head2 $deps->name + +Return the name of dependency from dependencies set. + +=head2 $deps->flags + +Return the sense flag of dependency from dependencies set. + +=head2 $deps->evr + +Return the version of dependency from dependencies set. + +=head2 $deps->nopromote($nopromote) + +Set or return the nopromote flags of the dependencies set. + +=head1 SEE ALSO + +L<Hdlist> +L<Hdlist::Header> + diff --git a/RPM4/lib/RPM4/Header/Files.pm b/RPM4/lib/RPM4/Header/Files.pm new file mode 100644 index 0000000..dd315d8 --- /dev/null +++ b/RPM4/lib/RPM4/Header/Files.pm @@ -0,0 +1,61 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +package RPM4::Header::Files; + +sub dircount { + $_[0]->countdir(); +} + +1; + +__END__ + +=head1 NAME + +Hdlist::Header::Files - A set of files and directories + +=head1 METHODS + +=head2 $files->count() + +Return the number of files contained by this set. + +=head2 $files->countdir() + +Return the number of directories contained by this set. + +=head2 $files->init() + +Reset internal files index and set it to -1. + +=head2 $files->initdir() + +Reset internal directories index and set it to -1. + +=head2 $deps->next() + +Set current file to the next one in the set. + +=head2 $deps->nextdir() + +Set current directory to the next one in the set. + +=head2 $files->move($index) + +Move internal file index to $index (0 by default). diff --git a/RPM4/lib/RPM4/Index.pm b/RPM4/lib/RPM4/Index.pm new file mode 100644 index 0000000..c94d0aa --- /dev/null +++ b/RPM4/lib/RPM4/Index.pm @@ -0,0 +1,163 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +package RPM4::Index; + +use strict; +use warnings; + +use RPM4; +use RPM4::Header; +use Packdrakeng; + +use File::Temp qw(tempfile); + +sub buildindex { + my (%options) = @_; + + my ($pid, $pack, $h_synthesis, $h_list); + if ($options{synthesis}) { + $pid = open($h_synthesis, "| gzip --best > '$options{synthesis}'") or return 0; + } + if ($options{hdlist}) { + $pack = Packdrakeng->new( + archive => $options{hdlist}, + comp_level => $options{complevel}, + ) or return 0; + } + if ($options{list}) { + open($h_list, ">", $options{list}) or return 0; + } + + RPM4::parserpms( + rpms => $options{rpms}, + callback => sub { + my (%res) = @_; + if(defined($options{callback})) { + $options{callback}->(%res) or return; + } + defined($res{header}) or return; + + if ($options{synthesis}) { + $res{header}->writesynthesis($h_synthesis, $options{filestoprovides}); + } + + if ($options{hdlist}) { + $res{header} or return; + # Hacking perl-URPM + my $h = $res{header}->copy(); # Get a copy to not alter original header + $h->addtag(1000000, 6, scalar($res{header}->fullname()) . '.rpm'); + $h->addtag(1000001, 4, (stat("$res{dir}$res{rpm}"))[7]); + my $fh = new File::Temp( UNLINK => 1, SUFFIX => '.header'); + $h->write($fh); + sysseek($fh, 0, 0); + $pack->add_virtual('f', scalar($res{header}->fullname()), $fh); + close($fh); + } + + if ($options{list}) { + print $h_list "$res{rpm}\n"; + } + + }, + checkrpms => $options{checkrpms}, + path => $options{path}, + + ); + + if ($options{synthesis}) { + close($h_synthesis); + waitpid $pid, 0; + } + + if($options{list}) { + close($h_list); + } + 1; +} + +sub buildsynthesis { + my (%options) = @_; + buildindex(%options); +} + +# Build only an hdlist file +sub buildhdlist { + my (%options) = @_; + buildindex(%options); +} + +sub parsehdlist { + my (%options) = @_; + my $pack = Packdrakeng->open(archive => $options{hdlist}) or return 0; + + my (undef, $files, undef) = $pack->getcontent(); + pipe(my $in, my $out); + if (my $pid = fork()) { + close($out); + stream2header($in, 0, sub { + #printf STDERR $header->fullname ."\n"; + $options{callback}->( + header => $_[0], + ); + }); + close($in); + waitpid($pid, 0); + } else { + close($in); + foreach my $h (@{$options{files} || $files || []}) { + $pack->extract_virtual($out, $h) >= 0 or die; + } + close($out); + exit; + } + 1; +} + +sub parsesynthesis { + my (%options) = @_; + + open(my $h, "cat '$options{synthesis}' | gunzip |") or return 0; + + my %hinfo = (); + while (my $line = <$h>) { + chomp($line); + my (undef, $type, $info) = split('@', $line, 3); + my @infos = split('@', $info); + if ($type =~ m/^(provides|requires|conflict|obsoletes)$/) { + @{$hinfo{$type}} = @infos; + } elsif ($type eq 'summary') { + $hinfo{summary} = $info; + } elsif ($type eq 'info') { + @hinfo{qw(fullname epoch size group)} = @infos; + + my $header = RPM4::headernew(); + $header->buildlight(\%hinfo); + $options{callback}->( + header => $header, + ); + + %hinfo = (); + } else { + } + } + close($h); + 1; +} + +1; diff --git a/RPM4/lib/RPM4/Media.pm b/RPM4/lib/RPM4/Media.pm new file mode 100644 index 0000000..5096e2b --- /dev/null +++ b/RPM4/lib/RPM4/Media.pm @@ -0,0 +1,193 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +package RPM4::Media; + +use strict; +use RPM4::Index; +use RPM4::Header; + +# $options = { +# prefixurl if need, ie real rpms locations +# type => rpms, hdlist, headers +# source => $ (hdlist,dir) or @ (rpms, headers) +sub new { + my ($class, %options) = @_; + my $media = { + hdlist => undef, + synthesis => undef, + list => 'list', + rpmsdir => undef, + + rpms => [], + + rpmn2path => {}, + id2path => {}, + + info => undef, + + hdr => [], + + use_light_header => 1, + }; + + foreach (keys %$media) { + defined($options{$_}) and $media->{$_} = $options{$_}; + } + + bless($media, $class); +} + +sub init { + my ($self, $callback) = @_; + + $self->{hdr} = []; + $self->{hdrid} = []; + my %reqfiles; + $self->{selectedhdrid} = {}; + $self->{reqfiles} = []; + + $callback ||= sub { + my (%arg) = @_; + @reqfiles{$arg{header}->requiredfiles()} = (); + 1; + }; + + if (defined(my $synthesis = $self->get_indexfile('synthesis'))) { + RPM4::Index::parsesynthesis( + synthesis => $synthesis, + callback => sub { + my %arg = @_; + $callback->(%arg) or return; + push(@{$self->{hdr}}, $arg{header}); + }, + ); + } elsif (defined(my $hdlist = $self->get_indexfile('hdlist'))) { + RPM4::Index::parsehdlist( + hdlist => $hdlist, + callback => sub { + my %arg = @_; + $callback->(%arg) or return; + $self->{selectedhdrid}{$arg{header}->tag('HDRID')} = 1; + }, + ); + } elsif (defined($self->{rpms})) { + my @rpms = grep { defined($_) } map { $self->get_rpm($_) } @{$self->{rpms}}; + RPM4::parserpms( + rpms => \@rpms, + callback => sub { + my %arg = @_; + $callback->(%arg) or return; + $self->{selectedhdrid}{$arg{header}->tag('HDRID')} = 1; + }, + ); + } + $self->{reqfiles} = [ keys %reqfiles ]; +} + +sub load { + my ($self, $reqfiles) = @_; + $reqfiles ||= $self->{reqfiles}; + + if (defined($self->get_indexfile('synthesis'))) { + # populate is done during first pass + } elsif (defined(my $hdlist = $self->get_indexfile('hdlist'))) { + RPM4::Index::parsehdlist( + hdlist => $hdlist, + callback => sub { + my %arg = @_; + $self->{selectedhdrid}{$arg{header}->tag('HDRID')} or return; + if ($self->{use_light_header}) { + my $h = $arg{header}->getlight($reqfiles); + push(@{$self->{hdr}}, $h); + } else { + push(@{$self->{hdr}}, $arg{header}); + } + }, + ); + } elsif (defined($self->{rpms})) { + my @rpms = grep { defined($_) } map { $self->get_rpm($_) } @{$self->{rpms}}; + RPM4::parserpms( + rpms => \@rpms, + callback => sub { + my %arg = @_; + $self->{selectedhdrid}{$arg{header}->tag('HDRID')} or return; + if ($self->{use_light_header}) { + my $h = $arg{header}->getlight($reqfiles); + push(@{$self->{hdr}}, $h); + } else { + push(@{$self->{hdr}}, $arg{header}); + } + $self->{id2path}{$#{$self->{hdr}}} = $arg{rpm}; + }, + ); + } + delete($self->{reqfiles}); + delete($self->{selectedhdrid}); + + if (my $listf = $self->get_indexfile('list')) { + if (open(my $lh, "<", $listf)) { + while (my $line = <$lh>) { + chomp($line); + my ($fullname) = $line =~ m,^(?:.*/)?(.*)\.rpm$,; + $self->{rpmn2path}{$fullname} = $line; + } + close($lh); + } + } +} + +sub traverse { + my ($self, $callback) = @_; + + foreach my $id (0 .. $#{$self->{hdr} || []}) { + my $header = $self->{hdr}[$id]; + $callback->($header, $id) or return; + } +} + +sub get_header { + my ($self, $id) = @_; + return $self->{hdr}[$id]; +} + +sub get_indexfile { + my ($self, $file) = @_; + defined($self->{$file}) or return undef; + my $f = + (substr($self->{$file}, 0, 1) ne '/' && defined($self->{rpmsdir}) ? "$self->{rpmsdir}/" : "") . + $self->{$file}; + -e $f ? $f : undef; +} + +sub id2rpm { + my ($self, $id) = @_; + my $rpm = $self->get_header($id)->fullname; + return exists($self->{rpmn2path}{$rpm}) ? $self->{rpmn2path}{$rpm} : + (exists($self->{id2path}{$id}) ? $self->{id2path}{$id} : "$rpm.rpm"); +} + +sub get_rpm { + my ($self, $rpm) = @_; + my $file = + (substr($rpm, 0, 1) ne '/' && defined($self->{rpmsdir}) ? "$self->{rpmsdir}/" : "") . + $rpm; + -e $file ? $file : undef; +} + +1; diff --git a/RPM4/lib/RPM4/Spec.pm b/RPM4/lib/RPM4/Spec.pm new file mode 100644 index 0000000..d6c5b29 --- /dev/null +++ b/RPM4/lib/RPM4/Spec.pm @@ -0,0 +1,195 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +package RPM4::Spec; + +use strict; +use warnings; + +use RPM4; +use RPM4::Transaction::Problems; + +sub rpmbuild { + my ($spec, $flags, %options) = @_; + + $options{db} ||= RPM4::newdb(); + + my ($f) = $flags =~ /^(?:-)?b([pcibas])/; + $f or die "Unknown build options '$flags', should be b[pciabs]\n"; + my @buildflags; + for (qw/p c i/) { + $options{shortcircuit} && $f ne $_ and next; + /^p$/ and push (@buildflags, "PREP"); + /^c$/ and push (@buildflags, "BUILD"); + /^l$/ and push (@buildflags, "FILECHECK"); + /^i$/ and push (@buildflags, qw/INSTALL CHECK/); + $f eq $_ and last; + } + for ($f) { + /^a$/ and push(@buildflags, qw/PACKAGESOURCE PACKAGEBINARY/); + /^b$/ and push(@buildflags, qw/PACKAGEBINARY/); + /^s$/ and push(@buildflags, qw/PACKAGESOURCE/); + } + $options{clean} and push(@buildflags, qw/RMBUILD RMSOURCE/); + $options{rmspec} and push(@buildflags, qw/RMSPEC/); + + + if (!$options{nodeps}) { + my $sh = $spec->srcheader() or die "Can't get source header from spec object"; # Can't happend + $options{db}->transadd($sh, "", 0); + $options{db}->transcheck; + my $pbs = RPM4::Transaction::Problems->new($options{db}); + $options{db}->transreset(); + if ($pbs) { + $pbs->print_all(\*STDERR); + return 1; + } + } + return $options{db}->specbuild($spec, [ @buildflags ]); +} + +1; + +__END__ + +=head1 NAME + +RPM4::Spec + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +Extend method availlable on RPM4::Spec objects + +=head1 METHODS + +=head2 new(file, var => value, ...) + +Create a C<RPM4::Spec> instance, only the file values is mandatory. + +=over 4 + +=item file + +The spec file from wich to create the object + +=item passphrase + +If specified, the passphrase will be used for gpg signing after build. + +=item rootdir + +If specified, root dir will be use root instead '/'. + +=item cookies + +the cookies is string rpm will put into RPMCOOKIES tag, a way to know if a rpm +has been built from a specific src. You get this value from L<installsrpm>. + +=item anyarch + +If set, you'll get a spec object even the spec can't be build on the +current %_target_cpu. Notice if you set this value, starting a build over +the spec object will works ! + +=item force + +Normally, source analyze is done during spec parsing, getting a spec object +failed if a source file is missing, else you set force value. + +TAKE CARE: if force is set, rpm will not check source type, so patch will NOT +be gunzip/bunzip... If you want to compile the spec, don't set it to 1, if you +just want run clean/packagesource stage, setting force to 1 is ok. + +=back + +By default anyarch and force are set to 0. + +=head2 RPM4::Spec->srcheader() + +Returns a RPM4::Header object like source rpm will be. +Please notice that the header is not finish and header information you'll +get can be incomplete, it depend if you call the function before or after +RPM4::Spec->build(). + +=head2 RPM4::Spec->srcrpm() + +Returns the source filename spec file will build. The function take care +about rpmlib configuration (build dir path). + +=head2 RPM4::Spec->binrpm() + +Returns files names of binaries rpms that spec will build. The function take +care about rpmlib configuration (build dir path). + +=head2 RPM4::Spec->build([ @actions ]) + +Run build process on spec file. +Each value in @actions is one or more actions to do: + + - PACKAGESOURCE: build source package, + - PREP: run prep stage, + - BUILD: run build stage, + - INSTALL: run install stage, + - CHECK: check installed files, + - FILECHECK: check installed files, + - PACKAGEBINARY: build binaries packages, + - CLEAN: run clean stage, + - RMSPEC: delete spec file, + - RMSOURCE: delete sources files, + - RMBUILD: delete build files, + +=head2 rpmbuild($flags, %options) + +Build a spec using rpm same rpm options. + +$flags should be -b[abspci] + +%options is a list of optionnal options: + +=over 4 + +=item db + +reuse an already existing RPM4::Db object (else a new one is created) + +=item clean + +if set, clean source and build tre (like rpmbuild --clean + +=item rmspec + +if set, delete the spec after build (like rpmbuild --rmspec) + +=item nodeps + +If set, don't check dependancies before build + +=item shortcircuit + +if set, run only the build stage asked, not all preceding (like rpmbuild +--short-circuit) + +=back + +=head1 SEE ALSO + +L<RPM4> + +=cut diff --git a/RPM4/lib/RPM4/Transaction.pm b/RPM4/lib/RPM4/Transaction.pm new file mode 100644 index 0000000..a62be4d --- /dev/null +++ b/RPM4/lib/RPM4/Transaction.pm @@ -0,0 +1,195 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +use strict; +use warnings; +use RPM4::Transaction::Problems; + +package RPM4::Transaction; + +sub newspec { + my ($self, $filename, %options) = @_; + $options{transaction} = $self; + RPM4::Spec->new( + $filename, + %options + ); +} + +sub transpbs { + my ($self) = @_; + return RPM4::Transaction::Problems->new($self); +} + +1; + +__END__ + +=head1 NAME + +Hdlist::Db + +=head1 DESCRIPTION + +This object allow to access to the rpm datadase and installing rpms on the +system. + +=head1 METHODS + +=head2 Hdlist::Db->traverse_headers(sub) + +Go through the rpm database and for each header run the callback passed as +argument. + +Argument passed to the callback function is the current header as a Hdlist::Header object. + +Ex: + $db->traverse_headers( sub { + my ($h) = @_; + print $h->queryformat("%{NAME}-%{VERSION}-%{RELEASE}.%{ARCH}"); + }); + + +=head2 Hdlist::Db->injectheader($header) + +Add the header into rpmdb. This is not installing a package, the function +only fill information into the rpmdb. + +Return 0 on success. + +=head2 Hdlist::Db->deleteheader($index) + +Remove header from rpmdb locate at $index. This is not uninstalling a package, +this function only delete information from rpmdb. + +Return 0 on success + +=head2 Hdlist::Db->transadd(header, filename, upgrade, relocation, force) + +Add rpm headers for next transaction. This means this rpm are going to be +installed on the system. + +- header is an Hdlist::Header object, + +- filename, if given, is the rpm file you want to install, and should +of course match the header, + +- upgrade is a boolean flag to indicate whether the rpm is going to be upgraded +(1 by default). + +Returns 0 on success. + +See: $Hdlist::Db->transcheck(), $Hdlist::Db->transrun(). + +=head2 Hdlist::Db->transremove(rpm_name) + +Add rpm to remove for next transaction. This mean the rpm will be uninstalled +from the system. + +Argument is the exact rpm name (%{NAME}) or a string as NAME(EPOCH:VERSION-RELEASE). + +Returns the number of selected rpms for this transaction. + +=head2 Hdlist::Db->transcheck() + +Check current transaction is possible. + +Returns 0 on success, 1 on error during check. + +=head2 Hdlist::Db->transorder() + +Call to rpmlib to order the transaction, aka sort rpm installation / +desintallation. + +Returns 0 on success. + +=head2 Hdlist::Db->transpb + +Return an array of problem found during L<Hdlist::Db->transcheck> or +L<Hdlist::Db->transrun> + +=head2 Hdlist::Db->transrun($callback, $flags...) + +Really run transaction and install/uninstall packages. + +$callback can be: + +- undef value, let rpm show progression with some default value. + +- array ref: each value represent a rpm command line options: + + PERCENT: show percentage of progress (--percent) + HASH: print '#' during progression (--hash) + LABEL: show rpm name (--verbose) + +- code ref: rpm is fully silent, the perl sub is called instead. Arguments +passed to the subroutine are in a hash: + + filename => opened filename + header => current header in transaction + what => current transaction process + amount => amount of transaction + total => number of transaction to do + +flags: list of flags to set for transaction (see rpm man page): + +I<From rpm Transaction flag>: + + - NOSCRIPTS: --noscripts + - JUSTDB: --justdb + - NOTRIGGERS: --notriggers + - NODOCS: --excludedocs + - ALLFILES: --allfiles + - DIRSTASH: --dirstash + - REPACKAGE: --repackage + - NOTRIGGERPREIN: --notriggerprein + - NOPRE: --nopre + - NOPOST: --nopost + - NOTRIGGERIN: --notriggerin + - NOTRIGGERUN: --notriggerun + - NOPREUN: --nopreun + - NOPOSTUN: --nopostun + - NOTRIGGERPOSTUN: --notriggerpostun + - NOSUGGEST: --nosuggest + - NOMD5: --nomd5 + - ADDINDEPS: --aid + - noscripts: Do not running any scripts, neither triggers + +I<From rpm prob filter> + + - IGNOREOS: --ignoreos + - IGNOREARCH: --ignorearch + - REPLACEPKG: --replacepkgs + - REPLACENEWFILES: --replacefiles + - REPLACEOLDFILES: --replacefiles + - OLDPACKAGES: --oldpackage + - DISKSPACE: --ignoresize + - DISKNODE: --ignoresize + +Returns 0 on success. + +=head2 $db->transpbs + +Return a Hdlist::Db::Problems object containing problem found during +rpms installation/desinstallation. + +See L<Hdlist::Db::Problems> + +=head1 SEE ALSO + +L<Hdlist> diff --git a/RPM4/lib/RPM4/Transaction/Problems.pm b/RPM4/lib/RPM4/Transaction/Problems.pm new file mode 100644 index 0000000..0266c7f --- /dev/null +++ b/RPM4/lib/RPM4/Transaction/Problems.pm @@ -0,0 +1,115 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +use strict; +use warnings; + +use RPM4; +use RPM4::Transaction; + +package RPM4::Transaction::Problems; + +sub new { + my ($class, $ts) = @_; + my $pbs = { + _problems => $ts->_transpbs() || undef, + _counter => -1, + }; + + $pbs->{_problems} or return undef; + bless($pbs, $class); +} + +sub count { + my ($self) = @_; + return $self->{_problems}->count(); +} + +sub init { + my ($self) = @_; + $self->{_counter} = -1; +} + +sub hasnext { + my ($self) = @_; + return ++$self->{_counter} < $self->{_problems}->count(); +} + +sub problem { + my ($self) = @_; + return $self->{_problems}->fmtpb($self->{_counter}); +} + +sub is_ignore { + my ($self) = @_; + return $self->{_problems}->isignore($self->{_counter}); +} + +sub print_all { + my ($self, $handle) = @_; + $handle ||= *STDOUT; + $self->{_problems}->print($handle); +} + +1; + +__END__ + +=head1 NAME + +RPM4::Transaction::Problems + +RPM4::Transaction + +=head1 DESCRIPTION + +This module an object for a collection of problems return by the rpmlib +when trying to install or removing rpms from the system. + +=head1 METHODS + +=head2 new(ts) + +Create a new problems collection from transaction. Return undef if now +problems has been found in the transaction. + +=head2 $pbs->init + +Reset internal index and set it to -1, see L<$deps-\\>hasnext()> + +=head2 $pbs->hasnext + +Advance to next dependency in the set. +Return FALSE if no further problem availlable, TRUE otherwise. + +=head2 $pbs->problem + +Return a format string about current problem in the set + +=head2 $pbs->is_ignore + +Return True if the problem should be ignored + +=head2 $pbs->print_all($handle) + +Print all error problems into the given handle, STDOUT if not specified. + +=head1 SEE ALSO + +L<RPM4> +L<RPM4::Db> |