ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/util.pl
Revision: 1.1.1.1 (vendor branch)
Committed: Fri Feb 3 07:14:15 2006 UTC (18 years, 3 months ago) by root
Content type: text/plain
Branch: UPSTREAM
CVS Tags: rel-2_0, UPSTREAM_2006_03_15, LAST_C_VERSION, STABLE, UPSTREAM_2006_02_22, difficulty_fix_merge_060810_2300, UPSTREAM_2006_02_03
Branch point for: difficulty_fix
Changes since 1.1: +0 -0 lines
Log Message:
initial import

File Contents

# 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 ###