|
1 # |
|
2 # Copyright 2007 Intel Corporation |
|
3 # |
|
4 # Licensed under the Apache License, Version 2.0 (the "License"); |
|
5 # you may not use this file except in compliance with the License. |
|
6 # You may obtain a copy of the License at |
|
7 # |
|
8 # http://www.apache.org/licenses/LICENSE-2.0 |
|
9 # |
|
10 # Unless required by applicable law or agreed to in writing, software |
|
11 # distributed under the License is distributed on an "AS IS" BASIS, |
|
12 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
|
13 # See the License for the specific language governing permissions and |
|
14 # limitations under the License. |
|
15 # |
|
16 |
|
17 # |
|
18 # SWIG exported dtn api example in perl |
|
19 # |
|
20 |
|
21 use dtnapi; |
|
22 use strict; |
|
23 |
|
24 my $h = dtnapi::dtn_open(); |
|
25 if ($h == -1) { |
|
26 print "error in dtn_open\n"; |
|
27 } |
|
28 print "handle is $h\n"; |
|
29 |
|
30 my $src = dtnapi::dtn_build_local_eid($h, "src"); |
|
31 my $dst = dtnapi::dtn_build_local_eid($h, "dst"); |
|
32 |
|
33 print "src is $src, dst is $dst\n"; |
|
34 |
|
35 my $regid = dtnapi::dtn_find_registration($h, $dst); |
|
36 if ($regid != -1) { |
|
37 print "found existing registration -- id $regid, calling bind...\n"; |
|
38 dtnapi::dtn_bind($h, $regid); |
|
39 } else { |
|
40 $regid = dtnapi::dtn_register($h, $dst, $dtnapi::DTN_REG_DROP, 10, 0, ""); |
|
41 print("created new registration -- id $regid\n"); |
|
42 } |
|
43 |
|
44 print "sending a bundle in memory...\n"; |
|
45 my $id = dtnapi::dtn_send($h, $src, $dst, "dtn:none", $dtnapi::COS_NORMAL, |
|
46 0, 30, $dtnapi::DTN_PAYLOAD_MEM, "test payload"); |
|
47 |
|
48 print "bundle id: $id\n"; |
|
49 |
|
50 print " source: " . $id->{source} . "\n"; |
|
51 print " creation_secs: " . $id->{creation_secs} . "\n"; |
|
52 print " creation_seqno: " . $id->{creation_seqno} . "\n"; |
|
53 $id->DESTROY(); |
|
54 |
|
55 print "receiving a bundle in memory...\n"; |
|
56 my $bundle = dtnapi::dtn_recv($h, $dtnapi::DTN_PAYLOAD_MEM, 10000); |
|
57 |
|
58 print "bundle:\n"; |
|
59 print " source: " . $bundle->{source} . "\n"; |
|
60 print " dest: " . $bundle->{dest} . "\n"; |
|
61 print " replyto: " . $bundle->{replyto} . "\n"; |
|
62 print " priority: " . $bundle->{priority} . "\n"; |
|
63 print " dopts: " . $bundle->{dopts} . "\n"; |
|
64 print " expiration: " . $bundle->{expiration} . "\n"; |
|
65 print " creation_secs: " . $bundle->{creation_secs} . "\n"; |
|
66 print " creation_seqno: " . $bundle->{creation_seqno} . "\n"; |
|
67 print " payload: " . $bundle->{payload} . "\n"; |
|
68 |
|
69 $bundle->DESTROY(); |
|
70 |
|
71 print "dtn_recv timeout:\n"; |
|
72 $bundle = dtnapi::dtn_recv($h, $dtnapi::DTN_PAYLOAD_MEM, 0); |
|
73 if ($bundle || (dtnapi::dtn_errno($h) != $dtnapi::DTN_ETIMEOUT)) { |
|
74 print " bundle is $bundle, errno is ". dtnapi::dtn_errno($h) . "\n"; |
|
75 } else { |
|
76 print " " . dtnapi::dtn_strerror(dtnapi::dtn_errno($h)) . "\n"; |
|
77 } |
|
78 |
|
79 dtnapi::dtn_close($h); |
|
80 |
|
81 |