[packages/perl-Immunix] - deprecated part split from apparmor-utils, probably future versions of apparmor won't contain this
qboosh
qboosh at pld-linux.org
Sat Nov 1 11:14:42 CET 2014
commit b471fb5b6bbdb219ee6b586112f96dae2736555e
Author: Jakub Bogusz <qboosh at pld-linux.org>
Date: Sat Nov 1 11:14:42 2014 +0100
- deprecated part split from apparmor-utils, probably future versions of apparmor won't contain this
Ycp.pm | 328 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
perl-Immunix.spec | 45 ++++++++
2 files changed, 373 insertions(+)
---
diff --git a/perl-Immunix.spec b/perl-Immunix.spec
new file mode 100644
index 0000000..7be7886
--- /dev/null
+++ b/perl-Immunix.spec
@@ -0,0 +1,45 @@
+%include /usr/lib/rpm/macros.perl
+Summary: Deprecated Immunix Perl modules from AppArmor suite
+Summary(pl.UTF-8): Przestarzałe moduły Perla Immunix ze zbioru oprogramowania AppArmor
+Name: perl-Immunix
+Version: 2.9.0
+Release: 1
+Epoch: 1
+License: GPL v2
+Group: Development/Languages/Perl
+Source0: http://launchpad.net/apparmor/2.9/%{version}/+download/apparmor-%{version}.tar.gz
+# Source0-md5: daaeb859452f793abfdafd33f88d3e90
+Source1: Ycp.pm
+URL: http://apparmor.wiki.kernel.org/
+BuildRequires: rpm-perlprov
+Requires: perl-DBD-SQLite >= 1.08
+BuildArch: noarch
+BuildRoot: %{tmpdir}/%{name}-%{version}-root-%(id -u -n)
+
+%define _noautoreq 'perl(ycp)'
+
+%description
+Deprecated Immunix Perl modules from AppArmor suite.
+
+%description -l pl.UTF-8
+Przestarzałe moduły Perla Immunix ze zbioru oprogramowania AppArmor.
+
+%prep
+%setup -q -n apparmor-%{version}
+
+%install
+rm -rf $RPM_BUILD_ROOT
+
+%{__make} -C deprecated/utils install \
+ DESTDIR=$RPM_BUILD_ROOT
+# PERLDIR=$RPM_BUILD_ROOT%{perl_vendorlib}/Immunix
+
+cp -p %{SOURCE1} $RPM_BUILD_ROOT%{perl_vendorlib}/Immunix
+
+%clean
+rm -rf $RPM_BUILD_ROOT
+
+%files
+%defattr(644,root,root,755)
+%dir %{perl_vendorlib}/Immunix
+%{perl_vendorlib}/Immunix/*.pm
diff --git a/Ycp.pm b/Ycp.pm
new file mode 100644
index 0000000..4a7e179
--- /dev/null
+++ b/Ycp.pm
@@ -0,0 +1,328 @@
+# $Id$
+#
+
+# ------------------------------------------------------------------
+#
+# Copyright (C) 2002-2005 Novell/SUSE
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of version 2 of the GNU General Public
+# License published by the Free Software Foundation.
+#
+# ------------------------------------------------------------------
+
+package Immunix::Ycp;
+
+use strict;
+use warnings;
+#use Data::Dumper;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(y2milestone y2debug ParseCommand Return ycpReturn ycpReturnSkalarAsString ycpReturnHashAsMap ycpGetCommand ycpGetArgType);
+
+sub y2milestone {
+
+ my $mesg = shift;
+ my $logFile = '/var/log/YaST2/imx-log';
+
+ if ( open(LOG, ">>$logFile") ) {
+ my $date = localtime;
+ print LOG "$date: $mesg\n";
+ close LOG;
+ }
+
+}
+
+sub y2error {
+
+ my $mesg = shift;
+ my $logFile = '/var/log/YaST2/imx-errors';
+
+ if ( open(LOG, ">>$logFile") ) {
+ my $date = localtime;
+ print LOG "$date: ERROR: $mesg\n";
+ close LOG;
+ }
+}
+
+sub y2debug {
+
+ my $mesg = shift;
+ my $logFile = '/var/log/YaST2/imx-debug';
+
+ if ( open(LOG, ">>$logFile") ) {
+ my $date = localtime;
+ print LOG "$date: DEBUG: $mesg\n";
+ close LOG;
+ }
+}
+
+sub ycpGetCommand { }
+sub ycpGetArgType { }
+
+sub perlToYcp {
+
+ my $ref = shift;
+
+ my $string;
+
+ if(ref($ref) eq "HASH") {
+ $string = '$[';
+ for my $key (keys %$ref) {
+ if($key =~ m/^\d+$/) {
+ $string .= "$key:" . perlToYcp($ref->{$key}) . ",";
+ } else {
+ $string .= "\"$key\":" . perlToYcp($ref->{$key}) . ",";
+ }
+ }
+ $string .= '] ';
+ } elsif(ref($ref) eq "ARRAY") {
+ $string = '[';
+ for my $element (@$ref) {
+ $string .= perlToYcp($element) . ',';
+ }
+ $string .= '] ';
+ } elsif(defined $ref) {
+
+ if($ref =~ m/^(true|false|nil|\d+)$/) {
+ $string = "$ref";
+ } else {
+ $string = "\"$ref\"";
+ }
+ } else {
+ $string = "nil";
+ }
+ return $string;
+}
+
+sub Return {
+ my $data = shift;
+
+ return ycpReturn($data);
+}
+
+sub ycpReturn {
+ my $data = shift;
+
+ my $string;
+ if(ref($data)) {
+ $string = perlToYcp($data);
+ } else {
+ $string = "(" . perlToYcp($data) . ")";
+ }
+ $| = 1;
+ print $string;
+}
+
+sub ycpReturnHashAsMap {
+ my %hash = @_;
+
+ return ycpReturn(\%hash);
+}
+
+sub ycpReturnSkalarAsString {
+ my $scalar = shift;
+
+ return ycpReturn($scalar);
+}
+
+#my $data = { foo => [ "one", "two", "three" ], bar => "foobar" };
+#my $data = [ "foo", [ "one", "two", "three" ], "bar", "foobar" ];
+#Return($data);
+
+sub ycpToPerl {
+ my $string = shift || "";
+
+ my $original_string = $string;
+
+ my @stack = ( "TOPOFSTACK" );
+
+ my $tree;
+ my $where;
+ my $key = "";
+
+ # strip leading whitespace
+ $string =~ s/^\s+//;
+ # strip trailing comma or whitespace if they exist
+ $string =~ s/,?\s*$//;
+
+ while($string) {
+ if($string =~ s/^\$\[//s) { # beginning of a hash
+
+ # create a new hash ref
+ my $hash = { };
+
+ # insert it into the tree at our current location
+ if(not $tree) {
+ # if tree hasn't been set up yet, create it now as a hash
+ $tree = $hash;
+ $where = $tree;
+ } elsif(ref($where) eq "ARRAY") {
+ push @$where, $hash;
+ } elsif(ref($where) eq "HASH") {
+ if($key) {
+ $where->{$key} = $hash;
+ } else {
+ die "ERROR: trying to insert hash value without a key: $_";
+ }
+ } else {
+ die "ERROR: clowns ate my brain: $_";
+ }
+
+ # zero out out the key for the new hash...
+ $key = "";
+
+ # push the parent onto the stack
+ push @stack, $where;
+
+ # our new "current" location is the newly created hash
+ $where = $hash;
+
+ } elsif($string =~ s/^\[//s) { # beginning of an array
+
+ # create a new array ref
+ my $array = [ ];
+
+ # insert it into the tree at our current location
+ if(not $tree) {
+ # if tree hasn't been set up yet, create it now as an array
+ $tree = $array;
+ $where = $tree;
+ } elsif(ref($where) eq "ARRAY") {
+ push @$where, $array;
+ } elsif(ref($where) eq "HASH") {
+ if($key) {
+ $where->{$key} = $array;
+ } else {
+ die "ERROR: trying to insert hash value without a key: $_";
+ }
+ } else {
+ die "ERROR: Can't identify var for translation: $_";
+ }
+
+ $key = "";
+
+ # push the parent onto the stack
+ push @stack, $where;
+
+ # our new "current" location is the newly created array
+ $where = $array;
+
+ } elsif($string =~ s/^(true|false|nil)(?=[,:\]])//s) { # true/false
+ my $value = $1;
+
+ my $realvalue;
+ $realvalue = 1 if $value eq "true";
+ $realvalue = 0 if $value eq "false";
+ $realvalue = undef if $value eq "nil";
+
+ # shove it into the right place
+ if(ref($where) eq "HASH") {
+ if($key) {
+ $where->{$key} = $realvalue;
+ $key = "";
+ } else {
+ $key = $value;
+ }
+ } elsif(ref($where) eq "ARRAY") {
+ push @$where, $realvalue;
+ } else {
+ die "ERROR: awoooga! awooooga!: $string";
+ }
+ } elsif($string =~ s/^"([^"]*)"//s) { # normal string
+ my $value = $1;
+
+ # shove it into the right place
+ if(not $tree) {
+ $tree = $value;
+ } elsif(ref($where) eq "HASH") {
+ if($key) {
+ $where->{$key} = $value;
+ $key = "";
+ } else {
+ $key = $value;
+ }
+ } elsif(ref($where) eq "ARRAY") {
+ push @$where, $value;
+ } else {
+ die "ERROR: dogs don't know it's not bacon: $string";
+ }
+ } elsif($string =~ s/^(\d+)(?=[,:\]])//s) { # normal integer
+ my $value = $1;
+
+ # shove it into the right place
+ if(ref($where) eq "HASH") {
+ if($key) {
+ $where->{$key} = $value;
+ $key = "";
+ } else {
+ $key = $value; # ??? - can we use a bare integer as a hash key?
+ }
+ } elsif(ref($where) eq "ARRAY") {
+ push @$where, $value;
+ } else {
+ die "ERROR: one by one the penguins steal my sanity: $string";
+ }
+ } elsif($string =~ s/^\]//) {
+ # hit the end of this containing block, move back up a level
+ $where = pop @stack;
+ if($where eq "TOPOFSTACK") {
+ die "ERROR: popped off top of stack: $string";
+ }
+ } else {
+ y2error("ERROR: failed to parse: '$original_string'");
+ die "ERROR: failed to parse: '$original_string'";
+ }
+
+ # strip trailing : or , and any whitespace
+ $string=~ s/^[,:]\s*//s;
+ }
+
+ if(pop(@stack) ne "TOPOFSTACK") {
+ die "ERROR: stack depth mismatch";
+ }
+
+ return $tree;
+}
+
+sub ParseCommand {
+ my $string = shift;
+
+ chomp $string;
+ my $original_string = $string;
+
+ if($string=~ m/^`?(\S+)\s*\((.+)\)\s*$/) {
+ my ($cmd, $params) = ($1, $2);
+
+ if($params =~ m/^(\.\S*),\s*(.+)\s*$/) {
+ my ($path, $args) = ($1, ycpToPerl($2));
+
+ return ($cmd, $path, $args);
+ } elsif($params =~ m/^(\.\S*)$/) {
+ my $path = $1;
+
+ return ($cmd, $path, "");
+ } elsif($cmd eq "result" && $params eq "nil") {
+ return ($cmd, "", "");
+ } elsif($params eq "") {
+ return ($cmd, "", "");
+ } else {
+ die "ERROR: failed to parse params: $params - $original_string\n";
+ }
+ } else {
+ die "ERROR: failed to parse command: $string";
+ }
+
+}
+
+
+#my $foo = ycpToPerl('$["one":"1one", "two":"2two", "three":["foo", $["holy":"catfish", "bacon":"cheese"], "baz"]]');
+
+#my ($ycommand, $ypath, $yargument) = ParseCommand('Read(.foobar, $["one":"1one", "two":"2two", "three":["foo", $["holy":"catfish", "bacon":false], "baz"]])');
+
+#print Data::Dumper->Dump([$ycommand, $ypath, $yargument], [qw(*ycommand *ypath *yargument)]);
+#print Data::Dumper->Dump([$foo]);
+
+1;
+
================================================================
---- gitweb:
http://git.pld-linux.org/gitweb.cgi/packages/perl-Immunix.git/commitdiff/b471fb5b6bbdb219ee6b586112f96dae2736555e
More information about the pld-cvs-commit
mailing list