server/lib/util.pl

######################################################################
# subs
######################################################################

###
sub capitalize {
    local($str) = $_[0];
    local($head) = ord(substr($str,0,1));
    local($tail) = substr($str,1);
    $head = $head - 32 if $head >= 97 && $head ne '_';
    return sprintf("%c%s",$head,$tail);
}

###
sub uncapitalize {
    local($str) = $_[0];
    local($head) = ord(substr($str,0,1));
    local($tail) = substr($str,1);
    $head = $head + 32 if $head <= 97 && $head ne '_';
    return sprintf("%c%s",$head,$tail);
}

### user debug message
sub msg {
    print STDERR $0.": ".$_[0]."\n" if $debug;
}

###
sub die {
    $prog = &basename($0);
    print STDERR $prog.": ".$_[0]."\n";
    exit(1);
}

###
sub warn {
    $prog = &basename($0);
    print STDERR $prog.": ".$_[0]."\n" if ! $nowarn;
}

###
sub info {
    $prog = &basename($0);
    print STDERR $prog.": ".$_[0]."\n";
}

### basename of file
sub basename {
        local($name) = shift;
        local($ext) = shift;
        if($name =~ /.*\/.*/) {
            $name =~ s/.*\/(.*)$ext$/$1/;
        } else {
            $name =~ s/(.*)$ext$/$1/;
        }
        return $name;
}

###
sub dirname {
    local($name) = shift;
    $name =~ s/(^.*)\/.*$/$1/;
    return $name;
}

### make uniq to array
sub uniq {
    local(@list) = sort(@_);
    local($item,$prev);
    local(@uniq);
    foreach $item (@list) {
        push(@uniq,$item) if($item ne $prev);
        $prev = $item;
    }
    return @uniq;
}

1;

### end of util.pl ###
Revision:	1.2
Committed:	Sat May 26 15:44:07 2007 UTC (17 years ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.1:	+0 -0 lines
State:	*FILE REMOVED*
Log Message:	- restore after combined mainboard+harddisk crash - cleanup/fixes for 2.1 release - fix invoke to actually do work - refactor invoke shortcuts, gcc cannot inline varargs functions. - optimised invoke to 4-5 insns in the common case. - optimised (For no good reason) the int-to-ascii conversions of dynbuf_text into division-less and branchless code (of which I am pretty proud). - actually move players to their savebed when they did not use one and the map has been reste in the meantime. does not kill (yet) when too long. - enter_map is now handled completely in perl. - goto is now using generation counting to ensure that only the most-recently-issues goto will succeed. - make some heavy use of __builtin_expect to streamline rare callbacks even more. - optimised thawer.
#	User	Rev	Content
1	root	1.1	######################################################################
2			# subs
3			######################################################################
4
5			###
6			sub capitalize {
7			local($str) = $_[0];
8			local($head) = ord(substr($str,0,1));
9			local($tail) = substr($str,1);
10			$head = $head - 32 if $head >= 97 && $head ne '_';
11			return sprintf("%c%s",$head,$tail);
12			}
13
14			###
15			sub uncapitalize {
16			local($str) = $_[0];
17			local($head) = ord(substr($str,0,1));
18			local($tail) = substr($str,1);
19			$head = $head + 32 if $head <= 97 && $head ne '_';
20			return sprintf("%c%s",$head,$tail);
21			}
22
23			### user debug message
24			sub msg {
25			print STDERR $0.": ".$_[0]."\n" if $debug;
26			}
27
28			###
29			sub die {
30			$prog = &basename($0);
31			print STDERR $prog.": ".$_[0]."\n";
32			exit(1);
33			}
34
35			###
36			sub warn {
37			$prog = &basename($0);
38			print STDERR $prog.": ".$_[0]."\n" if ! $nowarn;
39			}
40
41			###
42			sub info {
43			$prog = &basename($0);
44			print STDERR $prog.": ".$_[0]."\n";
45			}
46
47			### basename of file
48			sub basename {
49			local($name) = shift;
50			local($ext) = shift;
51			if($name =~ /.\/./) {
52			$name =~ s/.\/(.)$ext$/$1/;
53			} else {
54			$name =~ s/(.*)$ext$/$1/;
55			}
56			return $name;
57			}
58
59			###
60			sub dirname {
61			local($name) = shift;
62			$name =~ s/(^.)\/.$/$1/;
63			return $name;
64			}
65
66			### make uniq to array
67			sub uniq {
68			local(@list) = sort(@_);
69			local($item,$prev);
70			local(@uniq);
71			foreach $item (@list) {
72			push(@uniq,$item) if($item ne $prev);
73			$prev = $item;
74			}
75			return @uniq;
76			}
77
78			1;
79
80			### end of util.pl ###