summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-11-24 19:45:35 +0100
committerSergey Poznyakoff <gray@gnu.org.ua>2017-11-24 20:15:47 +0100
commit1c5393a6f0498cb395452e521e81d802742db359 (patch)
tree4bbb1bbc0b451e25d0bbfb89e983f7d7a4e7927c
parent047e5e111a83ae82b13f0a75e48961c4ce656b40 (diff)
downloadslackbuilder-1c5393a6f0498cb395452e521e81d802742db359.tar.gz
slackbuilder-1c5393a6f0498cb395452e521e81d802742db359.tar.bz2
Introduce slackbuild registry. Add testsuite.
* .gitignore: New file. * lib/SlackBuild/Archive.pm (info): New method. * lib/SlackBuild/URI.pm (download): Make argument optional. Default to basename from the path. * lib/SlackBuilder.pm (%kws): New keyword: build (run): Fall back to the info{DOWNLOAD}, in case source_uri is not supplied. * lib/SlackBuild/Base.pm: New file. * lib/SlackBuild/Registry.pm: New file. * lib/SlackBuild/Registry/Backend/FS.pm: New file. * lib/SlackBuild/Registry/Record.pm: New file. * lib/SlackBuild/Registry/Version.pm: New file. * lib/SlackBuild/match.pm: New file. * t/regrec.t: New file. * t/vercmp.t: New file. * t/version.t: New file.
-rw-r--r--.gitignore7
-rw-r--r--lib/SlackBuild/Archive.pm31
-rw-r--r--lib/SlackBuild/Archive/Extractor/Tar.pm1
-rw-r--r--lib/SlackBuild/Base.pm41
-rw-r--r--lib/SlackBuild/Registry.pm54
-rw-r--r--lib/SlackBuild/Registry/Backend/FS.pm123
-rw-r--r--lib/SlackBuild/Registry/Record.pm148
-rw-r--r--lib/SlackBuild/Registry/Version.pm98
-rw-r--r--lib/SlackBuild/URI.pm5
-rw-r--r--lib/SlackBuild/match.pm65
-rw-r--r--lib/SlackBuilder.pm23
-rw-r--r--t/regrec.t31
-rw-r--r--t/vercmp.t32
-rw-r--r--t/version.t25
14 files changed, 679 insertions, 5 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..88b2c09
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,7 @@
+*~
+\#*#
+.#*
+*.tar*
+.emacs.*
+/tmp/
+core
diff --git a/lib/SlackBuild/Archive.pm b/lib/SlackBuild/Archive.pm
index 8167297..6d390c2 100644
--- a/lib/SlackBuild/Archive.pm
+++ b/lib/SlackBuild/Archive.pm
@@ -46,7 +46,36 @@ sub download {
unless ($self->SUPER::download($tmp)) {
return $self->error($self->SUPER::download_status);
}
- return SlackBuild::Archive::Extractor->backend($self, $tmp, $dst)->extract;
+ unless (SlackBuild::Archive::Extractor->backend($self, $tmp, $dst)
+ ->extract) {
+ return 0;
+ }
+ $self->_read_info($dst);
+ return 1;
+}
+
+sub _read_info {
+ my ($self, $dst) = @_;
+ my $info = $self->package_name . '.info';
+ return unless $self->has_file($info);
+ open(my $fd, '<', $dst . '/'. $info)
+ or return;
+ my %info;
+ while (<$fd>) {
+ chomp;
+ s/^\s+//;
+ next if /^(#.*)?$/;
+ return unless /^(?<kw>[A-Za-z_][A-Za-z_0-9]*)="(?<val>.*)"$/;
+ $info{$+{kw}} = $+{val};
+ }
+ close $fd;
+ $self->{_info} = \%info;
+}
+
+sub info {
+ my ($self, $kw) = @_;
+ return undef unless exists $self->{_info};
+ return $self->{_info}{$kw};
}
sub download_success {
diff --git a/lib/SlackBuild/Archive/Extractor/Tar.pm b/lib/SlackBuild/Archive/Extractor/Tar.pm
index b516893..1fcd428 100644
--- a/lib/SlackBuild/Archive/Extractor/Tar.pm
+++ b/lib/SlackBuild/Archive/Extractor/Tar.pm
@@ -33,7 +33,6 @@ sub _runcap_diag {
sub _run_tar {
my $self = shift;
-
my $obj = new POSIX::Run::Capture(argv => [ 'tar', @_ ],
timeout => 10);
if ($obj->run) {
diff --git a/lib/SlackBuild/Base.pm b/lib/SlackBuild/Base.pm
new file mode 100644
index 0000000..9710392
--- /dev/null
+++ b/lib/SlackBuild/Base.pm
@@ -0,0 +1,41 @@
+package SlackBuild::Base;
+use strict;
+use warnings;
+use Carp;
+use parent 'Exporter';
+no strict 'refs';
+
+sub import {
+ my $pkg = shift; # package
+ my ($package, $filename, $line) = caller;
+ foreach my $dfn (@_) {
+ if ($dfn =~ m/^(?<attr>[a-zA-Z_][a-zA-Z_0-9]*)
+ (?::(?<flag>.*))?$/x) {
+ my $attribute = $+{attr};
+ my $flag = $+{flag} || 'rw';
+ if ($flag eq 'ro') {
+ *{ $package . '::' . $attribute } = sub {
+ my $self = shift;
+ croak "too many arguments for ${package}::$attribute"
+ if @_;
+ return $self->{$attribute};
+ }
+ } else {
+ *{ $package . '::' . $attribute } = sub {
+ my $self = shift;
+ if (@_) {
+ croak "too many arguments for ${package}::$attribute"
+ if @_ > 1;
+ $self->{$attribute} = shift;
+ }
+ return $self->{$attribute};
+ }
+ }
+ } else {
+ croak "$filename:$line: bad attribute spec: $dfn"
+ }
+ }
+}
+
+1;
+
diff --git a/lib/SlackBuild/Registry.pm b/lib/SlackBuild/Registry.pm
new file mode 100644
index 0000000..8bbc7b8
--- /dev/null
+++ b/lib/SlackBuild/Registry.pm
@@ -0,0 +1,54 @@
+package SlackBuild::Registry;
+use strict;
+use warnings;
+use Carp;
+use SlackBuild::Base qw(backend:ro);
+
+=head1 NAME
+
+SlackBuild::Registry - registry of completed builds
+
+=head2 new
+
+ $x = new SlackBuild::Registry(BACKEND, KW=>VAL, ...)
+
+Creates new registry object. I<BACKEND> is the name of the backend
+to use. The class B<SlackBuild::Registry::Backend::I<BACKEND>> must
+exist. The arguments (I<KW =E<gt> VAL> pairs) are passed to its
+constructor.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $backend = shift or croak "no backend specified";
+ $backend = "SlackBuild::Registry::Backend::$backend";
+ eval "use $backend";
+ croak $@ if $@;
+ my $self = bless {}, $class;
+ $self->{backend} = $backend->new(@_);
+ return $self;
+}
+
+=head2 lookup
+
+ @a = $x->lookup(PACKAGE, [version=>X], [arch=>Y], [build=>Z])
+
+Returns a sorted array of SlackBuild::Registry::Record objects matching the
+search criteria.
+
+=cut
+
+sub lookup {
+ my $self = shift;
+ my $pkg = shift or croak "nothing to look up";
+ local %_ = @_;
+ return $self->backend->lookup($pkg, %_);
+}
+
+1;
+
+
+
+
+
diff --git a/lib/SlackBuild/Registry/Backend/FS.pm b/lib/SlackBuild/Registry/Backend/FS.pm
new file mode 100644
index 0000000..20e5df1
--- /dev/null
+++ b/lib/SlackBuild/Registry/Backend/FS.pm
@@ -0,0 +1,123 @@
+package SlackBuild::Registry::Backend::FS;
+use strict;
+use warnings;
+use Carp;
+use File::Basename;
+use List::Regexp;
+use File::stat;
+use Fcntl ':mode';
+use SlackBuild::Registry::Record;
+
+=head1 NAME
+
+SlackBuild::Registry::Backend::FS - filesystem backend for slackbuild registry
+
+=head1 SYNOPSIS
+
+ $reg = new SlackBuild::Registry(dir => DIRECTORY);
+ my @a = $x->lookup('openssl', version => '1.0.2m');
+
+=head1 METHODS
+
+=head2 new
+
+ $x = new SlackBuild::Registry::Backend::FS(dir => DIRECTORY)
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+ local %_ = @_;
+ if (my $dir = delete $_{dir}) {
+ $self->{dir} = $dir;
+ } else {
+ croak "required parameter dir not present";
+ }
+ croak "too many arguments" if keys %_;
+ return $self;
+}
+
+my @architectures = qw(i386 x86_64 arm);
+my @suffixes = qw(.tgz .txz);
+
+=head2 lookup
+
+ @a = $backend->lookup(PACKAGE, [version=>X], [arch=>Y], [build=>Z])
+
+Returns a sorted array of SlackBuild::Registry::Record objects matching the
+search criteria.
+
+=cut
+
+sub lookup {
+ my ($self, $pkg, %keys) = @_;
+ my $v;
+
+ my $pat = "$pkg-";
+ $pat .= ($keys{version} || '*') . '-';
+ $pat .= ($keys{arch} || '*') . '-';
+ if ($keys{build}) {
+ $pat .= $keys{build};
+ }
+ $pat .= '*';
+
+ my $rx = '^' . qr($pkg) . '-';
+ $rx .= '(?<version>';
+ if ($keys{version}) {
+ $rx .= qr($keys{version});
+ } else {
+ $rx .= '\d+(\.\d+)+.*?';
+ }
+ $rx .= ')-(?<arch>';
+ if ($keys{arch}) {
+ $rx .= qr($keys{arch});
+ } else {
+ $rx .= regexp_opt(@architectures);
+ }
+ $rx .= ')-(?<build>';
+ if ($keys{build}) {
+ $rx .= qr($keys{build});
+ } else {
+ $rx .= '\d+';
+ }
+ $rx .= ')(?<pfx>.*)$';
+
+ my @result = sort {
+ my $d;
+ if ($d = ($a->package || '') cmp ($b->package || '')) {
+ $d
+ } elsif ($d = $b->version <=> $a->version) {
+ $d
+ } elsif ($a->arch && $b->arch
+ && ($d = $a->arch cmp $b->arch)) {
+ $d
+ } else {
+ ($b->build || 1) <=> ($a->build || 1)
+ }
+ } map {
+ my ($name,$path,$suffix) = fileparse($_, @suffixes);
+ if ($name =~ m{$rx}) {
+ my $st = stat($_);
+ if (S_ISREG($st->mode)) {
+ new SlackBuild::Registry::Record($pkg,
+ version => $+{version},
+ arch => $+{arch},
+ build => $+{build},
+ date => $st->mtime,
+ filename => $_)
+ } else {
+ ()
+ }
+ } else {
+ ()
+ }
+ } (glob $self->{dir} . '/' . $pat);
+ if (wantarray) {
+ (@result)
+ } else {
+ shift @result;
+ }
+}
+
+1;
diff --git a/lib/SlackBuild/Registry/Record.pm b/lib/SlackBuild/Registry/Record.pm
new file mode 100644
index 0000000..90f6d05
--- /dev/null
+++ b/lib/SlackBuild/Registry/Record.pm
@@ -0,0 +1,148 @@
+package SlackBuild::Registry::Record;
+use strict;
+use warnings;
+use Carp;
+use SlackBuild::Base qw(package arch build date filename);
+use SlackBuild::Registry::Version;
+use SlackBuild::match;
+use Scalar::Util qw(blessed);
+
+=head2 new
+
+ $x = new SlackBuild::Registry::Record(PACKAGE,
+ arch=>X, version=>Y, build=>Z, date=>D, filename=>F)
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+ $self->build(1);
+ if (my $v = shift) {
+ $self->package($v);
+ if (@_) {
+ croak "bad number of arguments" if (@_ % 2);
+ local %_ = @_;
+ while (my ($k,$v) = each %_) {
+ $self->${\$k}($v);
+ }
+ }
+ }
+ return $self;
+}
+
+sub version {
+ my $self = shift;
+ if (@_) {
+ croak "too many arguments" if @_ > 1;
+ $self->{version} = new SlackBuild::Registry::Version(shift);
+ }
+ return $self->{version};
+}
+
+sub store {
+ my $self = shift;
+ croak "store not implemented";
+}
+
+sub as_string {
+ my $self = shift;
+ return $self->package . '-' . $self->version . '-' . $self->arch . '-' .
+ ($self->build || '1');
+}
+
+sub cmp {
+ my ($self, $other) = @_;
+
+ my $v;
+ if ($v = ($self->package || '') cmp ($other->package || '')) {
+ return $v;
+ }
+ if ($self->version <=> $other->version) {
+ return $v;
+ }
+ if ($self->arch && $other->arch
+ && ($v = $self->arch cmp $other->arch)) {
+ return $v;
+ }
+ return ($self->build || 1) <=> ($other->build || 1);
+}
+
+sub match_attr {
+ my ($self, $pred) = @_;
+ my ($meth, $arg);
+ if (ref($pred) eq 'ARRAY') {
+ croak "array must have 2 elements" unless @$pred == 2;
+ ($meth, $arg) = @$pred;
+ } elsif (ref($pred) eq 'HASH') {
+ croak "array must have 1 key" unless keys(%$pred) == 1;
+ ($meth, $arg) = each %$pred;
+ } else {
+ return $self == $pred;
+ }
+ return match($self->${ \$meth }, $arg);
+}
+
+sub matches {
+ my $self = shift;
+ my $args;
+ if (@_ == 1) {
+ if (ref($_[0]) eq 'HASH') {
+ $args = $_[0];
+ } else {
+ croak "bad argument";
+ }
+ } elsif (@_ % 2 == 0) {
+ local %_ = @_;
+ $args = \%_;
+ } else {
+ croak "odd number of arguments";
+ }
+ while (my ($meth, $pred) = each %$args) {
+ return 0 unless match($self->${ \$meth }, $pred);
+ }
+ return 1;
+}
+
+use overload
+ '""' => sub { shift->as_string },
+ 'cmp' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other);
+ return $swap ? -$res : $res;
+ },
+ '<=>' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other);
+ return $swap ? -$res : $res;
+ },
+ '==' => sub {
+ my ($self, $other) = @_;
+ my $res = $self->cmp($other) == 0;
+ },
+ '!=' => sub {
+ my ($self, $other) = @_;
+ my $res = $self->cmp($other) != 0;
+ },
+ '<' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other) < 0;
+ return $swap ? !$res : $res;
+ },
+ '<=' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other) <= 0;
+ return $swap ? !$res : $res;
+ },
+ '>' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other) > 0;
+ return $swap ? !$res : $res;
+ },
+ '>=' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other) >= 0;
+ return $swap ? !$res : $res;
+ };
+
+1;
diff --git a/lib/SlackBuild/Registry/Version.pm b/lib/SlackBuild/Registry/Version.pm
new file mode 100644
index 0000000..8a7d051
--- /dev/null
+++ b/lib/SlackBuild/Registry/Version.pm
@@ -0,0 +1,98 @@
+package SlackBuild::Registry::Version;
+use strict;
+use warnings;
+use Carp;
+use SlackBuild::Base qw(major minor patch tail string:ro);
+
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+ if (my $s = shift) {
+ croak "too many arguments" if @_;
+ $self->parse($s);
+ }
+ return $self;
+}
+
+sub major_number { shift->major || 0 };
+sub minor_number { shift->minor || 0 };
+sub patch_number { shift->patch || 0 };
+sub tail_string { shift->tail || '' };
+
+sub parse {
+ my ($self, $str) = @_;
+
+ $self->{string} = $str;
+ delete $self->{major};
+ delete $self->{minor};
+ delete $self->{patch};
+ delete $self->{tail};
+
+ if ($str =~ s/^(\d+)(.*)/$2/) {
+ $self->major($1);
+ if ($str =~ s/^\.(\d+)(.*)/$2/) {
+ $self->minor($1);
+ if ($str =~ s/^\.(\d+)(.*)/$2/) {
+ $self->patch($1);
+ }
+ }
+ }
+ $self->tail($str);
+}
+
+sub cmp {
+ my ($self, $other) = @_;
+
+ $other = __PACKAGE__->new($other) unless ref($other);
+
+ foreach my $part (map { "${_}_number" } qw(major minor patch)) {
+ if (my $d = $self->${\$part} <=> $other->${\$part}) {
+ return $d;
+ }
+ }
+ return $self->tail_string cmp $other->tail_string;
+}
+
+use overload
+ '""' => sub { shift->string },
+ 'cmp' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other);
+ return $swap ? -$res : $res;
+ },
+ '<=>' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other);
+ return $swap ? -$res : $res;
+ },
+ '==' => sub {
+ my ($self, $other) = @_;
+ my $res = $self->cmp($other) == 0;
+ },
+ '!=' => sub {
+ my ($self, $other) = @_;
+ my $res = $self->cmp($other) != 0;
+ },
+ '<' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other) < 0;
+ return $swap ? !$res : $res;
+ },
+ '<=' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other) <= 0;
+ return $swap ? !$res : $res;
+ },
+ '>' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other) > 0;
+ return $swap ? !$res : $res;
+ },
+ '>=' => sub {
+ my ($self, $other, $swap) = @_;
+ my $res = $self->cmp($other) >= 0;
+ return $swap ? !$res : $res;
+ };
+
+
+1;
diff --git a/lib/SlackBuild/URI.pm b/lib/SlackBuild/URI.pm
index 8556783..bd99321 100644
--- a/lib/SlackBuild/URI.pm
+++ b/lib/SlackBuild/URI.pm
@@ -4,6 +4,7 @@ use warnings;
use URI;
use Carp;
use LWP::UserAgent;
+use File::Basename;
# use LWP::Protocol::https;
# use LWP::Protocol::file;
# use LWP::Protocol::ftp;
@@ -51,8 +52,8 @@ sub new_abs {
use overload '""' => sub { shift->as_string };
sub download {
- croak "bad number of arguments" unless @_ == 2;
- my ($self, $dst) = @_;
+ my $self = shift;
+ my $dst = shift || basename($self->path);
my $scheme = $self->scheme;
require "LWP/Protocol/$scheme.pm";
print "downloading $self to $dst\n";
diff --git a/lib/SlackBuild/match.pm b/lib/SlackBuild/match.pm
new file mode 100644
index 0000000..9b99d95
--- /dev/null
+++ b/lib/SlackBuild/match.pm
@@ -0,0 +1,65 @@
+package SlackBuild::match;
+use strict;
+use warnings;
+use parent 'Exporter';
+use Carp;
+use Scalar::Util qw(looks_like_number);
+
+our @EXPORT = qw(match);
+
+my %matchtab = (
+ -eq => sub {
+ my ($a, $b) = @_;
+ (looks_like_number($a) && looks_like_number($b)) ? $a == $b : $a eq $b;
+ },
+ -ne => sub {
+ my ($a, $b) = @_;
+ (looks_like_number($a) && looks_like_number($b)) ? $a != $b : $a ne $b;
+ },
+ -lt => sub {
+ my ($a, $b) = @_;
+ (looks_like_number($a) && looks_like_number($b)) ? $a < $b : $a lt $b;
+ },
+ -le => sub {
+ my ($a, $b) = @_;
+ (looks_like_number($a) && looks_like_number($b)) ? $a <= $b : $a le $b;
+ },
+ -gt => sub {
+ my ($a, $b) = @_;
+ (looks_like_number($a) && looks_like_number($b)) ? $a > $b : $a gt $b;
+ },
+ -ge => sub {
+ my ($a, $b) = @_;
+ (looks_like_number($a) && looks_like_number($b)) ? $a > $b : $a ge $b;
+ },
+ -in => sub {
+ my ($a, $b) = @_;
+ croak 'argument to -in must be array'
+ unless ref($b) eq 'ARRAY';
+ foreach my $v (@$b) {
+ return 1
+ if (looks_like_number($a) && looks_like_number($v))
+ ? $a == $v : $a eq $v;
+ }
+ }
+);
+
+sub match {
+ my ($val, $pred) = @_;
+
+ my ($fun, $arg);
+ if (ref($pred) eq 'ARRAY') {
+ croak "array must have 2 elements" unless @$pred == 2;
+ ($fun, $arg) = @$pred;
+ } elsif (ref($pred) eq 'HASH') {
+ croak "array must have 1 key" unless keys(%$pred) == 1;
+ ($fun, $arg) = each %$pred;
+ } else {
+ return $val == $pred;
+ }
+
+ croak "unknown predicate: $fun"
+ unless (exists($matchtab{$fun}));
+
+ &{$matchtab{$fun}}($val, $arg);
+}
diff --git a/lib/SlackBuilder.pm b/lib/SlackBuilder.pm
index 0b100be..ed0d15a 100644
--- a/lib/SlackBuilder.pm
+++ b/lib/SlackBuilder.pm
@@ -102,6 +102,13 @@ my %kws = (
$self->package_version($v);
}
},
+ build => {
+ mandatory => 0,
+ set => sub {
+ my ($self, $v) = @_;
+ $self->package_build($v);
+ }
+ },
slackbuild_uri => {
mandatory => 1,
set => sub {
@@ -136,7 +143,12 @@ my %kws = (
}
);
-my @ATTRIBUTES = qw(package_name package_version slackbuild_uri source_uri prereq);
+my @ATTRIBUTES = qw(package_name
+ package_version
+ package_build
+ slackbuild_uri
+ source_uri
+ prereq);
{
no strict 'refs';
use feature 'state';
@@ -240,6 +252,15 @@ sub run {
. $self->source_uri->download_status);
return $self->errno(E_FAIL);
}
+ } elsif (my $d = $archive->info('DOWNLOAD')) {
+ foreach my $s (split /\s+/, $d) {
+ my $uri = new SlackBuild::URI($s);
+ my $dest = $self->wd . '/' . basename($uri->path);
+ unless ($uri->download($dest)) {
+ $self->error("can't download $uri: ".$uri->download_status);
+ return $self->errno(E_FAIL);
+ }
+ }
}
return $self->_build;
diff --git a/t/regrec.t b/t/regrec.t
new file mode 100644
index 0000000..6035c49
--- /dev/null
+++ b/t/regrec.t
@@ -0,0 +1,31 @@
+# -*- perl -*-
+use lib 't';
+use strict;
+use warnings;
+use SlackBuild::Registry::Record;
+use Test;
+
+plan tests => 6;
+
+my $r = new SlackBuild::Registry::Record('foo',
+ arch => 'x86_64',
+ version => '1.0',
+ build => 1,
+ date => 0);
+
+ok("$r", 'foo-1.0-x86_64-1');
+
+my $x = new SlackBuild::Registry::Record('foo',
+ arch => 'x86_64',
+ version => '1.0',
+ build => 2,
+ date => 0);
+
+ok($r < $x);
+ok($r <=> $x, -1);
+
+ok($r->matches(version => { -gt => '0.2' }));
+ok($r->matches(version => { -gt => '0.2' },
+ arch => { -in => [ qw(i386 x86_64)] }) );
+ok(!$r->matches(version => { -gt => '0.2' },
+ arch => { -eq => 'i386' }));
diff --git a/t/vercmp.t b/t/vercmp.t
new file mode 100644
index 0000000..54b1c80
--- /dev/null
+++ b/t/vercmp.t
@@ -0,0 +1,32 @@
+# -*- perl -*-
+use lib 't';
+use strict;
+use warnings;
+use SlackBuild::Registry::Version;
+use Test;
+
+plan tests => 8;
+
+ok(SlackBuild::Registry::Version->new('1.0') ==
+ SlackBuild::Registry::Version->new('1.0'));
+
+ok(SlackBuild::Registry::Version->new('1.0') <
+ SlackBuild::Registry::Version->new('1.1'));
+
+ok(SlackBuild::Registry::Version->new('1.0.1') >
+ SlackBuild::Registry::Version->new('1.0.0'));
+
+ok(SlackBuild::Registry::Version->new('1.0.1') >
+ SlackBuild::Registry::Version->new('1.0'));
+
+ok(SlackBuild::Registry::Version->new('2.1,6') <
+ SlackBuild::Registry::Version->new('2.2'));
+
+ok(SlackBuild::Registry::Version->new('1.0_A') <
+ SlackBuild::Registry::Version->new('1.0_B'));
+
+ok(SlackBuild::Registry::Version->new('1.3_Z') <
+ SlackBuild::Registry::Version->new('1.4_A'));
+
+ok(SlackBuild::Registry::Version->new('1.0') == '1.0');
+
diff --git a/t/version.t b/t/version.t
new file mode 100644
index 0000000..26c7d3e
--- /dev/null
+++ b/t/version.t
@@ -0,0 +1,25 @@
+# -*- perl -*-
+use lib 't';
+use strict;
+use warnings;
+use SlackBuild::Registry::Version;
+use Test;
+
+plan tests => 10;
+
+my $v = new SlackBuild::Registry::Version('4');
+ok($v->major, '4');
+ok(!$v->minor);
+ok(!$v->patch);
+
+$v = new SlackBuild::Registry::Version('4.1.9');
+ok($v->major, '4');
+ok($v->minor, '1');
+ok($v->patch, '9');
+
+$v = new SlackBuild::Registry::Version('4.1.9m');
+ok($v->major, '4');
+ok($v->minor, '1');
+ok($v->patch, '9');
+ok($v->tail, 'm');
+

Return to:

Send suggestions and report system problems to the System administrator.