package SlackBuild::Registry::Record; use strict; use warnings; use Carp; use SlackBuild::Base qw(package arch build date filename); use SlackBuild::Registry::Version; 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->version : '*') . '-' . ($self->arch ? $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); } 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;