diff options
author | Timothy Pearson <kb9vqf@pearsoncomputing.net> | 2013-01-27 01:00:43 -0600 |
---|---|---|
committer | Timothy Pearson <kb9vqf@pearsoncomputing.net> | 2013-01-27 01:00:43 -0600 |
commit | 2c4a290ae270924340991931a9e0ca793f8e9443 (patch) | |
tree | 7aa3b953d70dbdd6a5de525cdd7a5f4319ee1dd5 /knetwortdeconf/backends/util.pl.in | |
parent | 567923f30f7c0700cb526f26c20b5577bfe2a802 (diff) | |
download | tdeadmin-2c4a290ae270924340991931a9e0ca793f8e9443.tar.gz tdeadmin-2c4a290ae270924340991931a9e0ca793f8e9443.zip |
Rename a number of libraries and executables to avoid conflicts with KDE4
Diffstat (limited to 'knetwortdeconf/backends/util.pl.in')
-rw-r--r-- | knetwortdeconf/backends/util.pl.in | 463 |
1 files changed, 463 insertions, 0 deletions
diff --git a/knetwortdeconf/backends/util.pl.in b/knetwortdeconf/backends/util.pl.in new file mode 100644 index 0000000..b175fb8 --- /dev/null +++ b/knetwortdeconf/backends/util.pl.in @@ -0,0 +1,463 @@ +#!/usr/bin/env perl +#-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*- + +# Utility functions. +# +# Copyright (C) 2000-2001 Ximian, Inc. +# +# Authors: Hans Petter Jansson <hpj@ximian.com> +# Arturo Espinosa <arturo@ximian.com> +# Michael Vogt <mvo@debian.org> - Debian 2.[2|3] support. +# David Lee Ludwig <davidl@wpi.edu> - Debian 2.[2|3] support. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU Library General Public License as published +# by the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program 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 Library General Public License for more details. +# +# You should have received a copy of the GNU Library General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + + +# --- Utilities for strings, arrays and other data structures --- # + + +$SCRIPTSDIR = "@scriptsdir@"; +if ($SCRIPTSDIR =~ /^@scriptsdir[@]/) +{ + $SCRIPTSDIR = "."; + $DOTIN = ".in"; +} + +sub gst_max +{ + return ($_[0] > $_[1])? $_[0]: $_[1]; +} + +# Boolean <-> strings conversion. + +sub gst_util_read_boolean +{ + my ($v) = @_; + + return 1 if ($v =~ "true" || + $v =~ "yes" || + $v =~ "YES" || + $v =~ "on" || + $v eq "1"); + return 0; +} + + +sub gst_print_boolean_yesno +{ + if ($_[0] == 1) { return "yes"; } + return "no"; +} + + +sub gst_print_boolean_truefalse +{ + if ($_[0] == 1) { return "true"; } + return "false"; +} + + +sub gst_print_boolean_onoff +{ + if ($_[0] == 1) { return "on"; } + return "off"; +} + + +# Pushes a list to an array, only if it's not already in there. +# I'm sure there's a smarter way to do this. Should only be used for small +# lists, as it's O(N^2). Larger lists with unique members should use a hash. + +sub gst_push_unique +{ + my $arr = $_[0]; + my $found; + my $i; + + # Go through all elements in pushed list. + + for ($i = 1; $_[$i]; $i++) + { + # Compare against all elements in destination array. + + $found = ""; + for $elem (@$arr) + { + if ($elem eq $_[$i]) { $found = $elem; last; } + } + + if ($found eq "") { push (@$arr, $_[$i]); } + } +} + + +# Merges scr array into dest array. +sub gst_arr_merge +{ + my ($dest, $src) = @_; + my (%h, $i); + + foreach $i (@$a, @$b) + { + $h{$i} = 1; + } + + @$a = keys %h; + return $a; +} + +# Given an array and a pattern, it returns the index of the +# array that contains it +sub gst_array_find_index +{ + my($arrayRef, $pattern) = @_; + my(@array) = @{$arrayRef}; + my($numElements) = scalar(@array); + my(@indexes) = (0..$numElements); + my(@elements); + + @elements = grep @{$arrayRef}[$_] =~ /$pattern/, @indexes; + return(wantarray ? @elements : $elements[0]); +} + + + +sub gst_ignore_line +{ + if (($_[0] =~ /^[ \t]*\#/) || ($_[0] =~ /^[ \t\n\r]*$/)) { return 1; } + return 0; +} + + +# &gst_item_is_in_list +# +# Given: +# * A scalar value. +# * An array. +# this function will return 1 if the scalar value is in the array, 0 otherwise. + +sub gst_item_is_in_list +{ + my ($value, @arr) = @_; + my ($item); + + foreach $item (@arr) + { + return 1 if $value eq $item; + } + + return 0; +} + + +# Recursively compare a structure made of nested arrays and hashes, diving +# into references, if necessary. Circular references will cause a loop. +# Watch it: arrays must have elements in the same order to be equal. +sub gst_util_struct_eq +{ + my ($a1, $a2) = @_; + my ($type1, $type2); + my (@keys1, @keys2); + my ($elem1, $elem2); + my $i; + + $type1 = ref $a1; + $type2 = ref $a2; + + return 0 if $type1 != $type2; + return 1 if $a1 eq $a2; + return 0 if (!$type1); # Scalars + + if ($type1 eq "SCALAR") { + return 0 if $$a1 ne $$a2; + } + elsif ($type1 eq "ARRAY") + { + return 0 if $#$a1 != $#$a2; + + for ($i = 0; $i <= $#$a1; $i++) + { + return 0 if !&gst_util_struct_eq ($$a1[$i], $$a2[$i]); + } + } + elsif ($type1 eq "HASH") { + @keys1 = sort keys (%$a1); + @keys2 = sort keys (%$a2); + + return 0 if !&gst_util_struct_eq (\@keys1, \@keys2); + foreach $i (@keys1) + { + return 0 if !&gst_util_struct_eq ($$a1{$i}, $$a2{$i}); + } + } + else + { + return 0; + } + + return 1; +} + + +# &gst_get_key_for_subkeys +# +# Given: +# * A hash-table with its values containing references to other hash-tables, +# which are called "sub-hash-tables". +# * A list of possible keys (stored as strings), called the "match_list". +# this method will look through the "sub-keys" (the keys of each +# sub-hash-table) seeing if one of them matches up with an item in the +# match_list. If so, the key will be returned. + +sub gst_get_key_for_subkeys +{ + my %hash = %{$_[0]}; + my @match_list = @{$_[1]}; + + foreach $key (keys (%hash)) + { + my %subhash = %{$hash{$key}}; + foreach $item (@match_list) + { + if ($subhash{$item} ne "") { return $key; } + } + } + + return ""; +} + + +# &gst_get_key_for_subkey_and_subvalues +# +# Given: +# * A hash-table with its values containing references to other hash-tables, +# which are called "sub-hash-tables". These sub-hash-tables contain +# "sub-keys" with associated "sub-values". +# * A sub-key, called the "match_key". +# * A list of possible sub-values, called the "match_list". +# this function will look through each sub-hash-table looking for an entry +# whose: +# * sub-key equals match_key. +# * sub-key associated sub-value is contained in the match_list. + +sub gst_get_key_for_subkey_and_subvalues +{ + my %hash = %{$_[0]}; + my $key; + my $match_key = $_[1]; + my @match_list = @{$_[2]}; + + foreach $key (keys (%hash)) + { + my %subhash = %{$hash{$key}}; + my $subvalue = $subhash{$match_key}; + + if ($subvalue eq "") { next; } + + foreach $item (@match_list) + { + if ($item eq $subvalue) { return $key; } + } + } + + return ""; +} + + +# --- IP calculation --- # + + +# &gst_ip_calc_network (<IP>, <netmask>) +# +# Calculates the network address and returns it as a string. + +sub gst_ip_calc_network +{ + my @ip_reg1; + my @ip_reg2; + + @ip_reg1 = ($_[0] =~ /([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)/); + @ip_reg2 = ($_[1] =~ /([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)/); + + $ip_reg1[0] = ($ip_reg1[0] * 1) & ($ip_reg2[0] * 1); + $ip_reg1[1] = ($ip_reg1[1] * 1) & ($ip_reg2[1] * 1); + $ip_reg1[2] = ($ip_reg1[2] * 1) & ($ip_reg2[2] * 1); + $ip_reg1[3] = ($ip_reg1[3] * 1) & ($ip_reg2[3] * 1); + + return join ('.', @ip_reg1); +} + + +# &gst_ip_calc_network (<IP>, <netmask>) +# +# Calculates the broadcast address and returns it as a string. + +sub gst_ip_calc_broadcast +{ + my @ip_reg1; + my @ip_reg2; + + @ip_reg1 = ($_[0] =~ /([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)/); + @ip_reg2 = ($_[1] =~ /([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)/); + + @ip_reg1 = ($cf_hostip =~ /([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)/); + + $ip_reg1[0] = ($ip_reg1[0] * 1) | (~($ip_reg2[0] * 1) & 255); + $ip_reg1[1] = ($ip_reg1[1] * 1) | (~($ip_reg2[1] * 1) & 255); + $ip_reg1[2] = ($ip_reg1[2] * 1) | (~($ip_reg2[2] * 1) & 255); + $ip_reg1[3] = ($ip_reg1[3] * 1) | (~($ip_reg2[3] * 1) & 255); + + return join ('.', @ip_reg1); +} + +# Forks a process, running $proc with @args in the child, and +# printing the returned value of $proc in the pipe. Parent +# returns a structure with useful data about the process. +sub gst_process_fork +{ + my ($proc, @args) = @_; + my $pid; + local *PARENT_RDR; + local *CHILD_WTR; + + pipe (PARENT_RDR, CHILD_WTR); + + $pid = fork (); + if ($pid) + { + # Parent + close CHILD_WTR; + return {"pid" => $pid, "fd" => *PARENT_RDR, "fileno" => fileno (*PARENT_RDR)}; + } + else + { + my $ret; + close PARENT_RDR; + # Child + $ret = &$proc (@args); + my $type = ref ($ret); + + if (!$type) + { + print CHILD_WTR $ret; + } + elsif ($type eq 'ARRAY') + { + print CHILD_WTR "$_\n" foreach (@$ret); + } + + close CHILD_WTR; + exit (0); + } +} + + +# Close pipe, kill process, wait for it to finish. +sub gst_process_kill +{ + my ($proc) = @_; + + &gst_file_close ($$proc{"fd"}); + kill 2, $$proc{"pid"}; + waitpid ($$proc{"pid"}, undef); +} + + +# Populate a bitmap of the used file descriptors. +sub gst_process_list_build_fd_bitmap +{ + my ($procs) = @_; + my ($bits, $proc); + + foreach $proc (@$procs) + { + vec ($bits, $$proc{"fileno"}, 1) = 1; + } + + return $bits; +} + + +# Receives a seconds timeout (may be float) and a ref to +# a list of processes (each returned by gst_fork_process), and +# set the "ready" key to true in all the procs that are ready +# to return values, false otherwise. Returns time left before +# timeout. +sub gst_process_list_check_ready +{ + my ($timeout, $procs) = @_; + my ($bits, $bitsleft, $bitsready, $timestamp, $timeleft); + + $procs = [ $procs ] if ref ($procs) ne 'ARRAY'; + $bits = &gst_process_list_build_fd_bitmap ($procs); + + # Check with timeout which descriptors are ready with info. + $timeout = undef if $timeout == 0; + $timeleft = $timeout; + $bitsleft = $bits; + while (($timeout eq undef) || ($timeleft > 0)) + { + $timestamp = time; + select ($bitsleft, undef, undef, $timeleft); + $timeleft -= time - $timestamp if $timeout ne undef; + + $bitsready |= $bitsleft; + $bitsleft = $bits & (~$bitsready); + last if $bitsready eq $bits; + } + $bits = $bitsready; + + # For every process, set "ready" key to 1/0 depending on + # its file descriptor bit. + foreach $proc (@$procs) + { + $$proc{"ready"} = (ord ($bits) & (1 << $$proc{"fileno"}))? 1 : 0; + } + + return $timeleft; +} + + +sub gst_process_result_collect +{ + my ($proc, $func, @args) = @_; + my ($value, $tmp, $lines); + + if ($$proc{"ready"}) + { + my @list; + + $lines .= $tmp while (sysread ($$proc{"fd"}, $tmp, 4096)); + goto PROC_KILL unless $lines; + if ($lines =~ /\n/) + { + @list = split ("\n", $lines); + } + else + { + push @list, $line; + } + + $value = &$func (\@list, @args); + } + + PROC_KILL: + &gst_process_kill ($proc); + + return $value; +} + + +1; |