diff options
Diffstat (limited to 'share/perl/lib/OpenSim/Utility.pm')
-rw-r--r-- | share/perl/lib/OpenSim/Utility.pm | 155 |
1 files changed, 155 insertions, 0 deletions
diff --git a/share/perl/lib/OpenSim/Utility.pm b/share/perl/lib/OpenSim/Utility.pm new file mode 100644 index 0000000..7fc91e7 --- /dev/null +++ b/share/perl/lib/OpenSim/Utility.pm | |||
@@ -0,0 +1,155 @@ | |||
1 | package OpenSim::Utility; | ||
2 | |||
3 | use strict; | ||
4 | use XML::RPC; | ||
5 | use XML::Simple; | ||
6 | use Data::UUID; | ||
7 | use DBHandler; | ||
8 | use OpenSim::Config; | ||
9 | use Socket; | ||
10 | |||
11 | sub XMLRPCCall { | ||
12 | my ($url, $methodname, $param) = @_; | ||
13 | my $xmlrpc = new XML::RPC($url); | ||
14 | my $result = $xmlrpc->call($methodname, $param); | ||
15 | return $result; | ||
16 | } | ||
17 | |||
18 | sub XMLRPCCall_array { | ||
19 | my ($url, $methodname, $param) = @_; | ||
20 | my $xmlrpc = new XML::RPC($url); | ||
21 | my $result = $xmlrpc->call($methodname, @$param); | ||
22 | return $result; | ||
23 | } | ||
24 | |||
25 | sub UIntsToLong { | ||
26 | my ($int1, $int2) = @_; | ||
27 | return $int1 * 4294967296 + $int2; | ||
28 | } | ||
29 | |||
30 | sub getSimpleResult { | ||
31 | my ($sql, @args) = @_; | ||
32 | my $dbh = &DBHandler::getConnection($OpenSim::Config::DSN, $OpenSim::Config::DBUSER, $OpenSim::Config::DBPASS); | ||
33 | my $st = new Statement($dbh, $sql); | ||
34 | return $st->exec(@args); | ||
35 | } | ||
36 | |||
37 | sub GenerateUUID { | ||
38 | my $ug = new Data::UUID(); | ||
39 | my $uuid = $ug->create(); | ||
40 | return $ug->to_string($uuid); | ||
41 | } | ||
42 | |||
43 | sub ZeroUUID { | ||
44 | return "00000000-0000-0000-0000-000000000000"; | ||
45 | } | ||
46 | |||
47 | sub HEX2UUID { | ||
48 | my $hex = shift; | ||
49 | Carp::croak("$hex is not a uuid") if (length($hex) != 32); | ||
50 | my @sub_uuids = ($hex =~ /(\w{8})(\w{4})(\w{4})(\w{4})(\w{12})/); | ||
51 | return join("-", @sub_uuids); | ||
52 | } | ||
53 | |||
54 | sub BIN2UUID { | ||
55 | # TODO: | ||
56 | } | ||
57 | |||
58 | sub UUID2HEX { | ||
59 | my $uuid = shift; | ||
60 | $uuid =~ s/-//g; | ||
61 | return $uuid; | ||
62 | } | ||
63 | |||
64 | sub UUID2BIN { | ||
65 | my $uuid = shift; | ||
66 | return pack("H*", &UUID2HEX($uuid)); | ||
67 | } | ||
68 | |||
69 | sub HttpPostRequest { | ||
70 | my ($url, $postdata) = @_; | ||
71 | $url =~ /http:\/\/([^:\/]+)(:([0-9]+))?(\/.*)?/; | ||
72 | my ($host, $port, $path) = ($1, $3, $4); | ||
73 | $port ||= 80; | ||
74 | $path ||= "/"; | ||
75 | my $CRLF= "\015\012"; | ||
76 | my $addr = (gethostbyname($host))[4]; | ||
77 | my $name = pack('S n a4 x8', 2, $port, $addr); | ||
78 | my $data_len = length($postdata); | ||
79 | socket(SOCK, PF_INET, SOCK_STREAM, 0); | ||
80 | connect(SOCK, $name) ; | ||
81 | select(SOCK); $| = 1; select(STDOUT); | ||
82 | print SOCK "POST $path HTTP/1.0$CRLF"; | ||
83 | print SOCK "Host: $host:$port$CRLF"; | ||
84 | print SOCK "Content-Length: $data_len$CRLF"; | ||
85 | print SOCK "$CRLF"; | ||
86 | print SOCK $postdata; | ||
87 | |||
88 | my $ret = ""; | ||
89 | unless (<SOCK>) { | ||
90 | close(SOCK); | ||
91 | Carp::croak("can not connect to $url"); | ||
92 | } | ||
93 | my $header = ""; | ||
94 | while (<SOCK>) { | ||
95 | $header .= $_; | ||
96 | last if ($_ eq $CRLF); | ||
97 | } | ||
98 | if ($header != /200/) { | ||
99 | return $ret; | ||
100 | } | ||
101 | while (<SOCK>) { | ||
102 | $ret .= $_; | ||
103 | } | ||
104 | return $ret; | ||
105 | } | ||
106 | # TODO : merge with POST | ||
107 | sub HttpGetRequest { | ||
108 | my ($url) = @_; | ||
109 | $url =~ /http:\/\/([^:\/]+)(:([0-9]+))?(\/.*)?/; | ||
110 | my ($host, $port, $path) = ($1, $3, $4); | ||
111 | $port ||= 80; | ||
112 | $path ||= "/"; | ||
113 | my $CRLF= "\015\012"; | ||
114 | my $addr = (gethostbyname($host))[4]; | ||
115 | my $name = pack('S n a4 x8', 2, $port, $addr); | ||
116 | socket(SOCK, PF_INET, SOCK_STREAM, 0); | ||
117 | connect(SOCK, $name) ; | ||
118 | select(SOCK); $| = 1; select(STDOUT); | ||
119 | print SOCK "GET $path HTTP/1.0$CRLF"; | ||
120 | print SOCK "Host: $host:$port$CRLF"; | ||
121 | print SOCK "$CRLF"; | ||
122 | |||
123 | unless (<SOCK>) { | ||
124 | close(SOCK); | ||
125 | Carp::croak("can not connect to $url"); | ||
126 | } | ||
127 | while (<SOCK>) { | ||
128 | last if ($_ eq $CRLF); | ||
129 | } | ||
130 | my $ret = ""; | ||
131 | while (<SOCK>) { | ||
132 | $ret .= $_; | ||
133 | } | ||
134 | return $ret; | ||
135 | } | ||
136 | |||
137 | sub XML2Obj { | ||
138 | my $xml = shift; | ||
139 | my $xs = new XML::Simple( keyattr=>[] ); | ||
140 | return $xs->XMLin($xml); | ||
141 | } | ||
142 | |||
143 | sub Log { | ||
144 | my $server_name = shift; | ||
145 | my @param = @_; | ||
146 | open(FILE, ">>" . $OpenSim::Config::DEBUG_LOGDIR . "/" . $server_name . ".log"); | ||
147 | foreach(@param) { | ||
148 | print FILE $_ . "\n"; | ||
149 | } | ||
150 | print FILE "<<<<<<<<<<<=====================\n\n"; | ||
151 | close(FILE); | ||
152 | } | ||
153 | |||
154 | 1; | ||
155 | |||