From 416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5 Mon Sep 17 00:00:00 2001
From: Sebastian Schmelzer
Date: Thu, 2 Sep 2010 17:50:49 +0200
Subject: change dir structure

---
 src/bin/devel-tools/parseSusePatterns.pl | 163 +++++++++++++++++++++++++++++++
 1 file changed, 163 insertions(+)
 create mode 100755 src/bin/devel-tools/parseSusePatterns.pl

(limited to 'src/bin/devel-tools/parseSusePatterns.pl')

diff --git a/src/bin/devel-tools/parseSusePatterns.pl b/src/bin/devel-tools/parseSusePatterns.pl
new file mode 100755
index 00000000..a286cd71
--- /dev/null
+++ b/src/bin/devel-tools/parseSusePatterns.pl
@@ -0,0 +1,163 @@
+#! /usr/bin/perl
+# -----------------------------------------------------------------------------
+# Copyright (c) 2006, 2007 - OpenSLX GmbH
+#
+# This program is free software distributed under the GPL version 2.
+# See http://openslx.org/COPYING
+#
+# If you have any feedback please consult http://openslx.org/feedback and
+# send your suggestions, praise, or complaints to feedback@openslx.org
+#
+# General information about OpenSLX can be found at http://openslx.org/
+# -----------------------------------------------------------------------------
+# parseSusePatterns.pl
+#    - OpenSLX script to extract a package list from a given list of
+#      SUSE-pattern-files (*.pat).
+# -----------------------------------------------------------------------------
+use strict;
+use warnings;
+
+my $abstract = q[
+parseSusePatterns.pl
+    This script is a tool for OpenSLX developers that allows to extract
+    package lists from a given set of SUSE pattern files.
+];
+
+use Getopt::Long;
+use Pod::Usage;
+
+my (
+    $helpReq,
+    $versionReq,
+
+    %patternNames,
+    %packageNames,
+);
+
+GetOptions(
+    'help|?' => \$helpReq,
+    'version' => \$versionReq,
+) or pod2usage(2);
+pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $helpReq;
+if ($versionReq) {
+    system('slxversion');
+    exit 1;
+}
+
+if ($ARGV[0] !~ m[^(\w+)-(.+)$]) {
+    die "can't extract architecture from pattern file name '$ARGV[0]'";
+}
+my $arch = $2;
+
+foreach my $patternFile (@ARGV) {
+    parsePatternFile($patternFile, 1);
+}
+
+print join("\n", sort keys %packageNames)."\n";
+
+exit;
+
+sub parsePatternFile
+{
+    my $patternFile = shift;
+    my $outmost = shift;
+
+    my $patFH;
+    if (!open($patFH, '<', $patternFile)) {
+        return unless $outmost;
+        die "unable to open $patternFile";
+    }
+    undef $/;
+    my $content = <$patFH>;
+    close($patFH);
+    $patternNames{$patternFile} = 1;
+
+    if ($content =~ m[^\=Sum.de:\s*(.+?)\s*$]ms) {
+        print "+ $1\n";
+    }
+    if ($content =~ m[^\+Sug:\s*?$(.+?)^\-Sug:\s*?$]ms) {
+        addSubPatterns($1);
+    }
+    if ($content =~ m[^\+Req:\s*?$(.+?)^\-Req:\s*?$]ms) {
+        addSubPatterns($1);
+    }
+    if ($content =~ m[^\+Rec:\s*?$(.+?)^\-Rec:\s*?$]ms) {
+        addSubPatterns($1);
+    }
+    if ($content =~ m[^\+Prq:\s*?$(.+?)^\-Prq:\s*?$]ms) {
+        addPkgNames($1);
+    }
+    if ($content =~ m[^\+Prc:\s*?$(.+?)^\-Prc:\s*?$]ms) {
+        addPkgNames($1);
+    }
+    return;
+}
+
+sub addSubPatterns
+{
+    my $patternNames = shift;
+
+    my @subPatterns
+        = grep { length($_) > 0 }
+          map {
+              my $pattern = $_;
+              $pattern =~ s[^\s*(.+?)\s*$][$1];
+              $pattern;
+          }
+          split "\n", $patternNames;
+
+    foreach my $subPattern (@subPatterns) {
+        my $subPatternFile = "$subPattern-$arch";
+        if (!exists $patternNames{$subPatternFile}) {
+            parsePatternFile($subPatternFile);
+        }
+    }
+    return;
+}
+
+sub addPkgNames
+{
+    my $pkgs = shift;
+
+    my @pkgNames
+        = grep { length($_) > 0 }
+          map {
+              my $pkg = $_;
+              $pkg =~ s[^\s*(.+?)\s*$][$1];
+              $pkg;
+          }
+          split "\n", $pkgs;
+    foreach my $pkgName (@pkgNames) {
+        $packageNames{$pkgName} = 1;
+    }
+    return;
+}
+
+=head1 NAME
+
+parseSusePatterns.pl - OpenSLX script to extract a package list from
+a given list of SUSE-pattern-files (*.pat).
+
+=head1 SYNOPSIS
+
+parseSusePatterns.pl [options] <pattern-file> ...
+
+  Options:
+      --help                   brief help message
+      --version                show version
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<--help>
+
+Prints a brief help message and exits.
+
+=item B<--version>
+
+Prints the version and exits.
+
+=back
+
+=cut
\ No newline at end of file
-- 
cgit v1.2.3-55-g7522