home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / DebianLinux.pm < prev    next >
Encoding:
Perl POD Document  |  2011-07-26  |  2.7 KB  |  94 lines
  1. # Copyright 2011 Ben Hutchings
  2. #
  3. # This program is free software; you can redistribute it and/or modify
  4. # it under the terms of the GNU General Public License as published by
  5. # the Free Software Foundation; either version 2 of the License, or
  6. # (at your option) any later version.
  7. #
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. # GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program; if not, write to the Free Software
  15. # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  16.  
  17. package DebianLinux;
  18.  
  19. use strict;
  20. use warnings;
  21. use POSIX qw(uname);
  22.  
  23. BEGIN {
  24.     use Exporter ();
  25.     our @ISA = qw(Exporter);
  26.     our @EXPORT_OK = qw(version_cmp image_list);
  27. }
  28.  
  29. sub version_split {
  30.     # Split into numbers, hyphens with optional non-numeric suffixes
  31.     # (for pre-releases), and strings of any other characters
  32.     my $version = shift;
  33.     return $version =~ /(?:\d+|-\D*|[^-\d]+)/g;
  34. }
  35.  
  36. sub version_cmp {
  37.     my ($left_ver, $right_ver) = @_;
  38.     my @left_comp = version_split($left_ver);
  39.     my @right_comp = version_split($right_ver);
  40.  
  41.     for (my $i = 0; ; $i++) {
  42.     my $left = $left_comp[$i];
  43.     my $right = $right_comp[$i];
  44.     # Do the components indicate pre-releases?
  45.     my $left_pre = defined($left) && $left =~ /^-(?:rc|trunk)$/;
  46.     my $right_pre = defined($right) && $right =~ /^-(?:rc|trunk)$/;
  47.     # Are the components numeric?
  48.     my $left_num = defined($left) && $left =~ /^\d+/;
  49.     my $right_num = defined($right) && $right =~ /^\d+/;
  50.  
  51.     # Pre-releases sort before anything, even end-of-string
  52.     if ($left_pre or $right_pre) {
  53.         return -1 if !$right_pre;
  54.         return 1 if !$left_pre;
  55.     }
  56.     # End-of-string sorts before anything else.
  57.     # End-of-string on both sides means equality.
  58.     if (!defined($left) or !defined($right)) {
  59.         return -1 if defined($right);
  60.         return defined($left) || 0;
  61.     }
  62.     # Use numeric comparison if both sides numeric.
  63.     # Otherwise use ASCII comparison.
  64.     if ($left_num && $right_num) {
  65.         return -1 if $left < $right;
  66.         return 1 if $left > $right;
  67.     } else {
  68.         # Note that '.' > '-' thus 2.6.x.y > 2.6.x-z for any y, z.
  69.         return -1 if $left lt $right;
  70.         return 1 if $left gt $right;
  71.     }
  72.     }
  73. }
  74.  
  75. # Find kernel image name stem for this architecture
  76. my $image_stem;
  77. if ((uname())[4] =~ /^(?:mips|parisc|powerpc|ppc)/) {
  78.     $image_stem = 'vmlinux';
  79. } else {
  80.     $image_stem = 'vmlinuz';
  81. }
  82.  
  83. sub image_list {
  84.     my @results;
  85.     my $prefix = "/boot/$image_stem-";
  86.  
  87.     for (glob("$prefix*")) {
  88.     push @results, [substr($_, length($prefix)), $_];
  89.     }
  90.     return @results;
  91. }
  92.  
  93. 1;
  94.