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 (16 years, 11 months 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.
#	Content
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 ###