From 78e5bf1313f67e4cbc67fe01a408d27de7383abd Mon Sep 17 00:00:00 2001 From: Murray Cumming Date: Tue, 7 Jan 2003 16:59:16 +0000 Subject: Initial revision --- tools/pm/Util.pm | 113 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 113 insertions(+) create mode 100644 tools/pm/Util.pm (limited to 'tools/pm/Util.pm') diff --git a/tools/pm/Util.pm b/tools/pm/Util.pm new file mode 100644 index 00000000..c3076b4e --- /dev/null +++ b/tools/pm/Util.pm @@ -0,0 +1,113 @@ +# gtkmm - Util module +# +# Copyright 2001 Free Software Foundation +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. +# +# +# This file holds basic functions used throughout gtkmmproc modules. +# Functions in this module are exported so there is no need to +# request them by module name. +# +package Util; +use strict; +use warnings; + +BEGIN { + use Exporter (); + our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); + + # set the version for version checking + $VERSION = 1.00; + @ISA = qw(Exporter); + @EXPORT = qw(&string_unquote &string_trim &string_canonical + &trace &unique); + %EXPORT_TAGS = ( ); + + # your exported package globals go here, + # as well as any optionally exported functions + #@EXPORT_OK = qw($Var1 %Hashit &func3); + } +our @EXPORT_OK; + + +#$ string_unquote($string) +# Removes leading and trailing quotes. +sub string_unquote($) +{ + my ($str) = @_; + + $str =~ s/^['`"]// ; + $str =~ s/['`"]$// ; + + return $str; +} + +# $ string_trim($string) +# Removes leading and trailing white space. +sub string_trim($) +{ + ($_) = @_; + s/^\s+//; + s/\s+$//; + return $_; +} + +# $ string_canonical($string) +# Convert - to _. +sub string_canonical($) +{ + ($_) = @_; + s/-/_/g ; # g means 'replace all' + s/\//_/g ; # g means 'replace all' + return $_; +} + +# +# Back tracing utility. +# Prints the call stack. +# +# void trace() +sub trace() +{ + my ($package, $filename, $line, $subroutine, $hasargs, + $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1); + + no warnings qw(uninitialized); + + my $i = 2; + print "Trace on ${subroutine} called from ${filename}:${line}\n"; + while (1) + { + ($package, $filename, $line, $subroutine) = caller($i); + $i++; + next if ($line eq ""); + print " From ${subroutine} call from ${filename}:${line}\n"; + } +} + +sub unique(@) +{ + my %hash; + foreach (@_) + { + $hash{$_}=1; + } + + return keys %hash; +} + +1; # indicate proper module load. + -- cgit v1.2.1