mirror of
https://github.com/Project-OSS-Revival/alien.git
synced 2026-04-24 14:00:17 +00:00
merged in Fromslp.pm
This commit is contained in:
@@ -43,6 +43,10 @@ compatable with.)
|
|||||||
This is a translation table between architectures and the number
|
This is a translation table between architectures and the number
|
||||||
that represents them in a slp package.
|
that represents them in a slp package.
|
||||||
|
|
||||||
|
=item fieldlist
|
||||||
|
|
||||||
|
This is a list of all the fields in the order they appear in the footer.
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
use constant footer_size => 3784,
|
use constant footer_size => 3784,
|
||||||
@@ -62,7 +66,11 @@ use constant footer_size => 3784,
|
|||||||
2 => 'LGPL',
|
2 => 'LGPL',
|
||||||
3 => 'unknown',
|
3 => 'unknown',
|
||||||
254 => 'unknown',
|
254 => 'unknown',
|
||||||
};
|
},
|
||||||
|
fieldlist => [qw{conffiles priority compresstype release copyright
|
||||||
|
conflicts setupscript summary description depends
|
||||||
|
provides author date compiler version name arch
|
||||||
|
group slpkgversion}];
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
@@ -70,6 +78,16 @@ use constant footer_size => 3784,
|
|||||||
|
|
||||||
=over 4
|
=over 4
|
||||||
|
|
||||||
|
=item compresstype
|
||||||
|
|
||||||
|
Holds the compression type used in the slp file.
|
||||||
|
|
||||||
|
=item slpkgversion
|
||||||
|
|
||||||
|
Holds the slp package format version of the slp file.
|
||||||
|
|
||||||
|
=item
|
||||||
|
|
||||||
=head1 METHODS
|
=head1 METHODS
|
||||||
|
|
||||||
=over 4
|
=over 4
|
||||||
@@ -86,6 +104,24 @@ sub install {
|
|||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
=item getfooter
|
||||||
|
|
||||||
|
Pulls the footer out of the slp file and returns it.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getfooter {
|
||||||
|
my $this=shift;
|
||||||
|
my $file=$this->filename;
|
||||||
|
|
||||||
|
open (SLP,"<$file") || die "$file: $!";
|
||||||
|
# position at beginning of footer (2 = seek from EOF)
|
||||||
|
seek SLP,(- footer_size),2;
|
||||||
|
read SLP,$_,footer_size;
|
||||||
|
close SLP;
|
||||||
|
return $_;
|
||||||
|
}
|
||||||
|
|
||||||
=item scan
|
=item scan
|
||||||
|
|
||||||
Implement the scan method to read a slp file.
|
Implement the scan method to read a slp file.
|
||||||
@@ -97,13 +133,40 @@ sub scan {
|
|||||||
$this->SUPER::scan(@_);
|
$this->SUPER::scan(@_);
|
||||||
my $file=$this->filename;
|
my $file=$this->filename;
|
||||||
|
|
||||||
|
# Decode the footer.
|
||||||
|
my @values=unpack(footer_packstring,$this->getfooter);
|
||||||
|
# Populate fields.
|
||||||
|
foreach my $field (@{fieldlist}) {
|
||||||
|
$_=shift @values;
|
||||||
|
$this->$field($_);
|
||||||
|
}
|
||||||
|
|
||||||
|
# A simple sanity check.
|
||||||
|
if (! defined $this->slpkgversion || $this->slpkgversion < footer_version) {
|
||||||
|
die "unsupported stampede package version";
|
||||||
|
}
|
||||||
|
|
||||||
|
# Read in the file list.
|
||||||
|
my @filelist;
|
||||||
|
# FIXME: support gzip files too!
|
||||||
|
foreach (`bzip2 -d < $file | tar -tf -`) {
|
||||||
|
s:^\./:/:;
|
||||||
|
$_="/$_" unless m:^/:;
|
||||||
|
push @filelist, $fn;
|
||||||
|
}
|
||||||
|
|
||||||
|
# TODO: read in postinst script.
|
||||||
|
|
||||||
|
$this->distribution('Stampede');
|
||||||
|
$this->origformat('slp');
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
=item unpack
|
=item unpack
|
||||||
|
|
||||||
Implment the unpack method to unpack a slp file.
|
Unpack a slp file. They can be compressed in various ways, depending on
|
||||||
|
what is in the compresstype field.
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
@@ -111,7 +174,19 @@ sub unpack {
|
|||||||
my $this=shift;
|
my $this=shift;
|
||||||
$this->SUPER::unpack(@_);
|
$this->SUPER::unpack(@_);
|
||||||
my $file=$this->filename;
|
my $file=$this->filename;
|
||||||
|
my $compresstype=$this->compresstype;
|
||||||
|
|
||||||
|
if ($compresstype == 0) {
|
||||||
|
system("bzip2 -d $file | (cd ".$this->unpacked_tree."; tar xpf -") &&
|
||||||
|
die "unpack failed: $!";
|
||||||
|
}
|
||||||
|
elsif ($compresstype == 1) {
|
||||||
|
system("cat $file | (cd ".$this->unpacked_tree."; tar zxpf -") &&
|
||||||
|
die "unpack failed: $!";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
die "package uses an unknown compression type, $compresstype (please file a bug report)";
|
||||||
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -139,6 +214,71 @@ sub build {
|
|||||||
return # filename
|
return # filename
|
||||||
}
|
}
|
||||||
|
|
||||||
|
=item conffiles
|
||||||
|
|
||||||
|
Set/get conffiles.
|
||||||
|
|
||||||
|
When the conffiles are set, the format used by slp (a colon-delimited list)
|
||||||
|
is turned into the real list that is used internally.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub conffiles {
|
||||||
|
my $this=shift;
|
||||||
|
|
||||||
|
# set
|
||||||
|
$this->{conffiles}=[split /:/, shift]; if @_;
|
||||||
|
|
||||||
|
# get
|
||||||
|
return unless defined wantarray; # optimization
|
||||||
|
return $this->{conffiles};
|
||||||
|
}
|
||||||
|
|
||||||
|
=item copyright
|
||||||
|
|
||||||
|
Set/get copyright.
|
||||||
|
|
||||||
|
When the copyright is set, the number used by slp is changed into a textual
|
||||||
|
description. This is changed back into a number when the value is
|
||||||
|
retreived.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub copyright {
|
||||||
|
my $this=shift;
|
||||||
|
|
||||||
|
# set
|
||||||
|
$this->{copyright}=(${copyrighttrans}{shift} || 'unknown') if @_;
|
||||||
|
|
||||||
|
# get
|
||||||
|
return unless defined wantarray; # optimization
|
||||||
|
return $this->{copyright};
|
||||||
|
}
|
||||||
|
|
||||||
|
=item arch
|
||||||
|
|
||||||
|
Set/get arch.
|
||||||
|
|
||||||
|
When the arch is set, the number used by slp is changed into a textual
|
||||||
|
description. This is changed back into a number when the value is
|
||||||
|
retreived.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub arch {
|
||||||
|
my $this=shift;
|
||||||
|
|
||||||
|
# set
|
||||||
|
if (@_) {
|
||||||
|
$this->{arch}=(${archtrans}{shift};
|
||||||
|
die "unknown architecture" if ! $this->{arch};
|
||||||
|
}
|
||||||
|
|
||||||
|
# get
|
||||||
|
return unless defined wantarray; # optimization
|
||||||
|
return $this->{arch};
|
||||||
|
}
|
||||||
|
|
||||||
=head1 AUTHOR
|
=head1 AUTHOR
|
||||||
|
|
||||||
Joey Hess <joey@kitenet.net>
|
Joey Hess <joey@kitenet.net>
|
||||||
|
|||||||
Reference in New Issue
Block a user