This is the mail archive of the
cluster-cvs@sourceware.org
mailing list for the cluster.
cluster: STABLE3 - tool: Remove old perl scripts
- From: "Fabio M. Di Nitto" <fabbione at fedoraproject dot org>
- To: cluster-cvs-relay at redhat dot com
- Date: Fri, 23 Jan 2009 11:56:42 +0000 (UTC)
- Subject: cluster: STABLE3 - tool: Remove old perl scripts
Gitweb: http://git.fedorahosted.org/git/cluster.git?p=cluster.git;a=commitdiff;h=e18ff298cf1eceef248c06716f34941526c3338b
Commit: e18ff298cf1eceef248c06716f34941526c3338b
Parent: 858e14db82fa9fe344afdaef215de0003a8d76fe
Author: Steven Whitehouse <swhiteho@redhat.com>
AuthorDate: Fri Jan 23 09:54:23 2009 +0000
Committer: Fabio M. Di Nitto <fdinitto@redhat.com>
CommitterDate: Fri Jan 23 12:51:33 2009 +0100
tool: Remove old perl scripts
These are ancient and refer to gfs1 format lockdumps.
Signed-off-by: Steven Whitehouse <swhiteho@redhat.com>
---
gfs2/tool/decipher_lockstate_dump | 175 -------------------------------------
gfs2/tool/parse_lockdump | 158 ---------------------------------
2 files changed, 0 insertions(+), 333 deletions(-)
diff --git a/gfs2/tool/decipher_lockstate_dump b/gfs2/tool/decipher_lockstate_dump
deleted file mode 100644
index 96afcd7..0000000
--- a/gfs2/tool/decipher_lockstate_dump
+++ /dev/null
@@ -1,175 +0,0 @@
-#!/usr/bin/perl
-
-foreach $arg (@ARGV)
-{
- if ($arg eq '-nosort')
- {
- $nosort = 1;
- }
- else
- {
- push(@files, $arg);
- }
-}
-
-
-foreach $file (@files)
-{
- open(FILE, "< $file") || die "decipher_lockstate_dump: can't open file %s: $!\n";
-
- while ($line = <FILE>)
- {
- $line =~ s/\n/ \n/;
-
- if ($line =~ /^Glock/)
- {
- $ln++ if ($notfirst++);
- $line =~ s/\((0),/\(reserved[$1],/;
- $line =~ s/\((1),/\(nondisk[$1],/;
- $line =~ s/\((2),/\(inode[$1],/;
- $line =~ s/\((3),/\(rgrp[$1],/;
- $line =~ s/\((4),/\(meta[$1],/;
- $line =~ s/\((5),/\(iopen[$1],/;
- $line =~ s/\((6),/\(flock[$1],/;
- $line =~ s/\((7),/\(jid[$1],/;
- $line =~ s/\((8),/\(quota[$1],/;
- $line =~ s/\((9),/\(journal[$1],/;
-
- $line =~ s/\(nondisk(\S+), (0)\)/\(nondisk$1, mount[$2]\)/;
- $line =~ s/\(nondisk(\S+), (1)\)/\(nondisk$1, live[$2]\)/;
- $line =~ s/\(nondisk(\S+), (2)\)/\(nondisk$1, trans[$2]\)/;
- $line =~ s/\(nondisk(\S+), (3)\)/\(nondisk$1, rename[$2]\)/;
-
- $line =~ s/\(meta(\S+), (0)\)/\(meta$1, super[$2]\)/;
- $line =~ s/\(meta(\S+), (1)\)/\(meta$1, crap[$2]\)/;
-
- if ($line =~ /\(quota\S+, (\d+)\)/)
- {
- $qid = (($1 % 2) ? "Group" : "User") . int($1 / 2) . "[$1]";
- $line =~ s/\(quota(\S+), \d+\)/\(quota$1, $qid\)/;
- }
- }
- if ($line =~ /gl_flags/)
- {
- $line =~ s/ (0) / plug[$1] /;
- $line =~ s/ (1) / lock[$1] /;
- $line =~ s/ (2) / sticky[$1] /;
- $line =~ s/ (3) / prefetch[$1]/;
- $line =~ s/ (4) / sync[$1] /;
- $line =~ s/ (5) / dirty[$1] /;
- $line =~ s/ (6) / skip_waiters2[$1] /;
- $line =~ s/ (7) / greedy[$1] /;
- }
- if ($line =~ /state/)
- {
- $line =~ s/(0)/unlocked[$1]/;
- $line =~ s/(1)/exclusive[$1]/;
- $line =~ s/(2)/deferred[$1]/;
- $line =~ s/(3)/shared[$1]/;
- }
- if ($line =~ /gh_flags/)
- {
- $line =~ s/ (0) / try[$1] /;
- $line =~ s/ (1) / try_1cb[$1] /;
- $line =~ s/ (2) / noexp[$1] /;
- $line =~ s/ (3) / any[$1] /;
- $line =~ s/ (4) / priority[$1] /;
- $line =~ s/ (5) / local_excl[$1] /;
- $line =~ s/ (6) / async[$1] /;
- $line =~ s/ (7) / exact[$1] /;
- $line =~ s/ (8) / skip[$1] /;
- $line =~ s/ (9) / atime[$1] /;
- $line =~ s/ (10) / nocache[$1] /;
- $line =~ s/ (11) / sync[$1] /;
- $line =~ s/ (12) / nocancel[$1] /;
- $line =~ s/ (13) / never_recurse[$1] /;
- }
- if ($line =~ /gh_iflags/)
- {
- $line =~ s/ (0) / mutex[$1] /;
- $line =~ s/ (1) / promote[$1] /;
- $line =~ s/ (2) / demote[$1] /;
- $line =~ s/ (3) / greedy[$1] /;
- $line =~ s/ (4) / alloced[$1] /;
- $line =~ s/ (5) / dealloc[$1] /;
- $line =~ s/ (6) / holder[$1] /;
- $line =~ s/ (7) / first[$1] /;
- $line =~ s/ (8) / recurse[$1] /;
- $line =~ s/ (9) / aborted[$1] /;
- }
- if ($line =~ /owner/)
- {
- $line =~ s/(-1)/none[$1]/;
- }
- if ($line =~ /type/)
- {
- $line =~ s/(0)/unknown[$1]/;
- $line =~ s/(1)/fifo[$1]/;
- $line =~ s/(2)/character device[$1]/;
- $line =~ s/(4)/dirctory[$1]/;
- $line =~ s/(6)/block device[$1]/;
- $line =~ s/(8)/regular file[$1]/;
- $line =~ s/(10)/symlink[$1]/;
- $line =~ s/(12)/socket[$1]/;
- $line =~ s/(14)/whiteout[$1]/;
- }
- if ($line =~ /i_flags/)
- {
- $line =~ s/ (0) / qd_locked[$1] /;
- $line =~ s/ (1) / paged[$1] /;
- $line =~ s/ (2) / sw_paged[$1] /;
- }
-
- $locks[$ln] .= $line;
- }
-
- close(FILE);
-}
-
-
-@locks = sort funky @locks unless ($nosort);
-
-
-foreach $lock (@locks)
-{
- print $lock;
- print "\n" unless ($nosort);
-}
-
-
-
-sub funky
-{
- my($a_iopen, $b_iopen) = (0, 0);
- my($a_locked, $b_locked) = (0, 0);
- my($a_queued, $b_queued) = (0, 0);
- my($a_unlocked, $b_unlocked) = (0, 0);
-
-
- $a_iopen = 1 if ($a =~ /iopen/);
- $b_iopen = 1 if ($b =~ /iopen/);
-
- $a_locked = 1 if ($a =~ /gl_flags.*lock.*\n/);
- $b_locked = 1 if ($b =~ /gl_flags.*lock.*\n/);
-
- $a_queued = 1 if ($a =~ /Request/ ||
- $a =~ /Holder/ ||
- $a =~ /Waiter/);
- $b_queued = 1 if ($b =~ /Request/ ||
- $b =~ /Holder/ ||
- $b =~ /Waiter/);
-
- $a_unlocked = 1 if ($a =~ /gl_state.*unlocked.*\n/);
- $b_unlocked = 1 if ($b =~ /gl_state.*unlocked.*\n/);
-
-
- return ($a_iopen <=> $b_iopen) if ($a_iopen != $b_iopen);
- return -($a_locked <=> $b_locked) if ($a_locked != $b_locked);
- return -($a_queued <=> $b_queued) if ($a_queued != $b_queued);
- return ($a_unlocked <=> $b_unlocked) if ($a_unlocked != $b_unlocked);
-
-
- return 0;
-}
-
-
diff --git a/gfs2/tool/parse_lockdump b/gfs2/tool/parse_lockdump
deleted file mode 100644
index 9e77599..0000000
--- a/gfs2/tool/parse_lockdump
+++ /dev/null
@@ -1,158 +0,0 @@
-#!/usr/bin/perl
-
-&do_input(@ARGV);
-
-print 'Entries: ', scalar(@gl), "\n";
-print 'Glocks: ', scalar(keys(%gl)), "\n";
-print 'PIDs: ', scalar(keys(%pid)), "\n";
-print "\n";
-
-for ($x = 0; $x < @gl; $x++)
-{
- if (!$done[$x])
- {
- @chain = &find_chain($x);
- $req = 0;
-
- print scalar(@chain), " chain:\n";
-
- foreach $y (@chain)
- {
- print $gl[$y];
- $req++ if ($gl[$y] =~ /request/i);
- $done[$y]++;
- }
-
- print "$req requests\n";
- print "\n";
-
- $chains++;
- }
-}
-
-for ($x = 0; $x < @gl; $x++)
-{
- die "parse_lockdump: something is hosed\n" unless ($done[$x] == 1);
-}
-
-print "Chains: $chains\n";
-
-
-
-
-
-sub do_input
-{
- my(@host) = @_;
- my($host);
- local(*FILE);
- my($line);
- my($gl);
-
- foreach $host (@host)
- {
- open(FILE, "< $host") || die;
-
- while ($line = <FILE>)
- {
- if ($line eq "\n")
- {
- &file($host, $gl);
- $gl = '';
- }
- else
- {
- $gl .= $line;
- }
- }
-
- if ($gl ne '')
- {
- &file($host, $gl);
- $gl = '';
- }
-
- close(FILE);
- }
-}
-
-
-# Builds:
-#
-# @gl: A list of all the glock sections read in
-# @name: Contains the name of the glock of each member of @gl
-# @pid: Contains the pids contained in each member of @gl
-# %gl: Maps a lockname to the members of @gl that coorespond to that name
-# %pid: Maps a pid to the members of @gl that correspond to that pid
-
-sub file
-{
- my($host, $gl) = @_;
- my($x);
- my($name, $pid);
-
- ($name) = $gl =~ /^Glock (\(.*\))/;
-
- push(@gl, "$host $gl");
- $x = @gl - 1;
- push(@name, $name);
-
- $gl{$name} .= "$x ";
-
- foreach (split("\n", $gl))
- {
- if (/owner = (\d+)/)
- {
- $pid = "$host:$1";
-
- if (!&is_in($pid, split(' ', $pid[$x])))
- {
- $pid[$x] .= "$pid ";
- $pid{$pid} .= "$x ";
- }
- }
- }
-}
-
-
-sub find_chain
-{
- my($x, @chain) = @_;
- my($y, $z);
- my($name, $pid);
-
- $name = $name[$x];
-
- foreach $y (split(' ', $gl{$name}))
- {
- push(@chain, $y);
- }
-
- foreach $y (split(' ', $gl{$name}))
- {
- foreach $pid (split(' ', $pid[$y]))
- {
- foreach $z (split(' ', $pid{$pid}))
- {
- @chain = &find_chain($z, @chain) unless (&is_in($z, @chain));
- }
- }
- }
-
- return @chain;
-}
-
-
-sub is_in
-{
- my($val, @list) = @_;
-
- foreach (@list)
- {
- return 1 if ($_ eq $val);
- }
-
- return 0;
-}
-
-