3 # $Id: SW.pm,v 1.2 2004/04/08 01:52:19 mdw Exp $
5 # Handling for the `sw' index file
10 #----- Licensing notice -----------------------------------------------------
12 # This file is part of sw-tools.
14 # sw-tools is free software; you can redistribute it and/or modify
15 # it under the terms of the GNU General Public License as published by
16 # the Free Software Foundation; either version 2 of the License, or
17 # (at your option) any later version.
19 # sw-tools is distributed in the hope that it will be useful,
20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
24 # You should have received a copy of the GNU General Public License
25 # along with sw-tools; if not, write to the Free Software Foundation,
26 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28 #----- Package preamble -----------------------------------------------------
37 #----- Main code ------------------------------------------------------------
39 # --- @vcmp(a, b)@ ---
41 # Returns < 0, == 0 or > 0 depending on whether a < b, a == b, or a > b, in
42 # an ordering of version numbers. A version number is considered to be a
43 # sequence of digit strings and words, optionally separated by non-word
44 # characters. The digit sequences are compared using a numerical ordering.
45 # The words are compared lexically with the exception that a missing word is
46 # considered greater than all other strings.
54 if ($a eq $b) { return 0; }
56 # --- Extract leading digit sequences ---
58 ($aa, $ar) = $a =~ /^(\d+)(.*)/;
59 ($bb, $br) = $b =~ /^(\d+)(.*)/;
61 if ($aa == $bb) { next SECTION
; }
62 else { return $aa <=> $bb; }
65 # --- Extract leading word sequences ---
67 ($aa, $ar) = $a =~ /^(\w+)(.*)/;
68 ($bb, $br) = $b =~ /^(\w+)(.*)/;
69 if (defined($aa) || defined($bb)) {
70 if ($aa eq $bb) { next SECTION
; }
71 elsif ($aa eq "") { return +1; }
72 elsif ($bb eq "") { return -1; }
73 else { return $aa cmp $bb; }
76 # --- Strip leading non-word sequences ---
78 ($ar) = $a =~ /^\W+(.*)/;
79 ($br) = $b =~ /^\W+(.*)/;
88 # Reads an `sw' index file. Any EOF condition on the file is cleared before
89 # reading starts. This allows multiple reads to pick up any extra appends on
90 # the file. Returns the number of items read.
96 return unless $me->{fh
};
98 seek($me->{fh
}, 0, 1); # Clear EOF flag
100 while (my $line = $me->{fh
}->getline()) {
106 foreach my $f (split(/\s*\;\s*/, $line)) {
107 %map = (%map, split(/\s*=\s*|\s+/, $f, 2));
110 my $pkg = $map{"package"};
111 unless ($me->{map}{$pkg} && $me->{map}{$pkg}{"date"} gt $map{"date"}) {
112 $me->{map}{$pkg} = \
%map;
113 $me->{dirty
}{$pkg} = 1;
122 # Writes an `sw' index file. The old file is moved out of the way while the
123 # new one is written a line at a time. If everyone's playing the game right
124 # by using append mode, we should be OK. When the initial write is over, I
125 # remove the old file, and read and write any more items that were left in
132 unlink($me->{file
} . ".old");
133 rename($me->{file
}, $me->{file
} . ".old") or return undef;
134 $fh = IO
::File
->new($me->{file
}, O_APPEND
| O_CREAT
| O_WRONLY
);
137 my @which = $me->list();
139 ONE_THERES_A_SISSY
: for (;;) {
140 foreach my $i (@which) {
142 foreach my $j (qw(package version maintainer date arch only
-arch
)) {
143 $v = $me->{map}{$i}{$j};
147 $fh->print($l . "\n");
150 unlink($me->{file
} . ".old");
152 $me->read() or last ONE_THERES_A_SISSY
;
154 sort { $me->{map}{$a}{"date"} cmp $me->{map}{$b}{"date"} }
155 keys(%{$me->{dirty
}});
162 # Returns a list of package names.
166 return sort(keys(%{$me->{map}}));
171 # Returns (a reference to) a package's hash entry.
176 return $me->{map}{$pkg};
179 # --- @new([NAME])@ ---
181 # Opens a package index.
185 my $file = shift || "$C{prefix}/sw-index";
186 my $me = bless {}, $class;
187 my $fh = IO
::File
->new($file, O_RDONLY
);
194 #----- That's all, folks ----------------------------------------------------