--- /dev/null
+# -*-perl-*-
+#
+# $Id: SW.pm,v 1.1 1999/07/30 18:48:05 mdw Exp $
+#
+# Handling for the `sw' index file
+#
+# (c) 1999 EBI
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of sw-tools.
+#
+# sw-tools 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 of the License, or
+# (at your option) any later version.
+#
+# sw-tools 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 sw-tools; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Revision history -----------------------------------------------------
+#
+# $Log: SW.pm,v $
+# Revision 1.1 1999/07/30 18:48:05 mdw
+# Useful bits for the Perl support code.
+#
+
+#----- Package preamble -----------------------------------------------------
+
+package SW;
+
+use IO;
+use POSIX;
+
+use SWConfig;
+
+#----- Main code ------------------------------------------------------------
+
+# --- @vcmp(a, b)@ ---
+#
+# Returns < 0, == 0 or > 0 depending on whether a < b, a == b, or a > b, in
+# an ordering of version numbers. A version number is considered to be a
+# sequence of digit strings and words, optionally separated by non-word
+# characters. The digit sequences are compared using a numerical ordering.
+# The words are compared lexically with the exception that a missing word is
+# considered greater than all other strings.
+
+sub vcmp($$) {
+ my ($a, $b) = @_;
+ my ($aa, $bb);
+ my ($ar, $br);
+
+ SECTION: while (1) {
+ if ($a eq $b) { return 0; }
+
+ # --- Extract leading digit sequences ---
+
+ ($aa, $ar) = $a =~ /^(\d+)(.*)/;
+ ($bb, $br) = $b =~ /^(\d+)(.*)/;
+ if ($aa || $bb) {
+ if ($aa == $bb) { next SECTION; }
+ else { return $aa <=> $bb; }
+ }
+
+ # --- Extract leading word sequences ---
+
+ ($aa, $ar) = $a =~ /^(\w+)(.*)/;
+ ($bb, $br) = $b =~ /^(\w+)(.*)/;
+ if (defined($aa) || defined($bb)) {
+ if ($aa eq $bb) { next SECTION; }
+ elsif ($aa eq "") { return +1; }
+ elsif ($bb eq "") { return -1; }
+ else { return $aa cmp $bb; }
+ }
+
+ # --- Strip leading non-word sequences ---
+
+ ($ar) = $a =~ /^\W+(.*)/;
+ ($br) = $b =~ /^\W+(.*)/;
+ } continue {
+ $a = $ar;
+ $b = $br;
+ }
+}
+
+# --- @read()@ ---
+#
+# Reads an `sw' index file. Any EOF condition on the file is cleared before
+# reading starts. This allows multiple reads to pick up any extra appends on
+# the file. Returns the number of items read.
+
+sub read {
+ my $me = shift;
+ my $read = 0;
+
+ return unless $me->{fh};
+
+ seek($me->{fh}, 0, 1); # Clear EOF flag
+
+ while (my $line = $me->{fh}->getline()) {
+ my %map;
+
+ $read++;
+
+ chomp($line);
+ foreach my $f (split(/\s*\;\s*/, $line)) {
+ %map = (%map, split(/\s*=\s*|\s+/, $f, 2));
+ }
+
+ my $pkg = $map{"package"};
+ unless ($me->{map}{$pkg} && $me->{map}{$pkg}{"date"} gt $map{"date"}) {
+ $me->{map}{$pkg} = \%map;
+ $me->{dirty}{$pkg} = 1;
+ }
+ }
+
+ return $read;
+}
+
+# --- @write()@ ---
+#
+# Writes an `sw' index file. The old file is moved out of the way while the
+# new one is written a line at a time. If everyone's playing the game right
+# by using append mode, we should be OK. When the initial write is over, I
+# remove the old file, and read and write any more items that were left in
+# it.
+
+sub write {
+ my $me = shift;
+ my $fh;
+
+ unlink($me->{file} . ".old");
+ rename($me->{file}, $me->{file} . ".old") or return undef;
+ $fh = IO::File->new($me->{file}, O_APPEND | O_CREAT | O_WRONLY);
+ $fh->autoflush(1);
+
+ my @which = $me->list();
+
+ ONE_THERES_A_SISSY: for (;;) {
+ foreach my $i (@which) {
+ my $l = "";
+ foreach my $j (qw(package version maintainer date arch only-arch)) {
+ $v = $me->{map}{$i}{$j};
+ $l and $l .= "; ";
+ $l .= "$j = $v";
+ }
+ $fh->print($l . "\n");
+ }
+
+ unlink($me->{file} . ".old");
+ $me->{dirty} = {};
+ $me->read() or last ONE_THERES_A_SISSY;
+ @which =
+ sort { $me->{map}{$a}{"date"} cmp $me->{map}{$b}{"date"} }
+ keys(%{$me->{dirty}});
+ }
+ return 1;
+}
+
+# --- @list()@ ---
+#
+# Returns a list of package names.
+
+sub list {
+ my $me = shift;
+ return sort(keys(%{$me->{map}}));
+}
+
+# --- @get(PKG)@ ---
+#
+# Returns (a reference to) a package's hash entry.
+
+sub get {
+ my $me = shift;
+ my $pkg = shift;
+ return $me->{map}{$pkg};
+}
+
+# --- @new([NAME])@ ---
+#
+# Opens a package index.
+
+sub new {
+ my $class = shift;
+ my $file = shift || "$C{prefix}/sw-index";
+ my $me = bless {}, $class;
+ my $fh = IO::File->new($file, O_RDONLY);
+ $me->{file} = $file;
+ $me->{fh} = $fh;
+ $me->read();
+ return $me;
+}
+
+#----- That's all, folks ----------------------------------------------------
+
+1;
~mdw / sw-tools / blobdiff