1 # XmlBlaster.pm
2 #
3 # use XMLRPC (Frontier) for connecting to xmlBlaster
4 #
5 # 04/07/02 17:17 mad@ktaland.com
6 # upgrade
7 # 14/02/02 08:32 mad@ktaland.com
8 #
9 package xmlBlaster::XmlBlaster ;
10
11 use Data::Dumper;
12
13 use Frontier::Client;
14
15 use xmlBlaster::Exception ;
16 use xmlBlaster::ConnectQos ;
17 use xmlBlaster::MsgUnit ;
18 use xmlBlaster::PublishReturnQos ;
19
20 use strict;
21
22 ##############
23 sub new
24 {
25
26 my $class = shift;
27 # init from hash
28 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
29 bless( $self, $class );
30
31 $self->{'user'} = 'test' if( ! exists $self->{'user'} );
32 $self->{'passwd'} = 'secret' if( ! exists $self->{'passwd'} );
33 $self->{'host'} = 'localhost:8080' if( ! exists $self->{'host'} );
34
35 $self->{'server'} = undef ;
36 $self->{'sessionId'} = undef ;
37
38 return $self ;
39
40 }#new
41
42 ################
43 sub _getServer {
44
45 my $self = shift ;
46
47 if( ! defined($self->{'server'}) ){
48 $self->{'server'} = Frontier::Client->new( url => 'http://'.$self->{'host'}.'/' );
49 }
50 return $self->{'server'} ;
51
52 }#_getServer
53
54 ################
55 sub connect
56 {
57 my $self = shift ;
58
59 my $srv = $self->_getServer();
60
61 my $loginQos = xmlBlaster::ConnectQos->new(
62 {
63 'user' => $self->{'user'} ,
64 'passwd'=>$self->{'passwd'} ,
65 }
66 );
67
68 #print '='x40,"\nConnectQos XML :\n",Dumper( $loginQos->xml ),"\n",'='x40,"\n" ;
69
70 my $xml = $srv->call( 'authenticate.connect', $loginQos->xml );
71
72 #print '='x40,"\nConnectReturnQos XML :\n",Dumper( $xml ),"\n",'='x40,"\n" ;
73
74 $self->{'sessionId'} = $loginQos->sessionId( $xml ) ;
75
76 #print '='x40,"\nConnect loginQos :\n",Dumper( $loginQos ),"\n",'='x40,"\n" ;
77
78 return $self->{'sessionId'} ?1 :0 ;
79
80 }#connect
81
82 ##############
83 sub logout
84 {
85 my $self = shift ;
86
87 # Logout from xmlBlaster
88
89 $self->{'server'}->call( 'authenticate.logout', $self->{'sessionId'} );
90
91 return 1 ;
92
93 }#logout
94
95 ############
96 # parameters :
97 # - $key : must be defined
98 # - $content : optional
99 # - $qos : optional
100 sub publish
101 {
102 my( $self, $key, $content, $qos )=@_;
103
104 my $srv = $self->_getServer();
105
106 # a default empty key.
107 $key = '' if( ! $key ) ;
108
109 # a default Qos.
110 $qos = '<qos></qos>' if( ! $qos || $qos eq '' ) ;
111
112 # a default empty content.
113 $content = '' if( ! $content || $content eq '' ) ;
114
115 # 08/07/02 16:30 cyrille@ktaland.com
116 # no publish return a string like :
117 #
118 # <qos><state id=\'OK\'/><key oid=\'http://213.186.34.8:40000-1026138362565-3\'/></qos>
119 #
120
121 my $xml = $self->{'server'}->call( 'xmlBlaster.publish', $self->{'sessionId'}, $key,$content,$qos );
122
123 #print '='x40,"\n",Dumper( $xml ),"\n",'='x40,"\n" ;
124
125 my $publishretqos = xmlBlaster::PublishReturnQos->new( $xml );
126
127 #print '='x40,"\n",Dumper( $publishretqos ),"\n",'='x40,"\n" ;
128
129 return $publishretqos->keyOid() ;
130
131 }#publish
132
133 ############
134 # parameters :
135 # - $key : must be defined
136 # - $qos : optional
137 sub get
138 {
139 my( $self, $key, $qos )=@_;
140
141 if( ! $key ){
142 throw( new xmlBlaster::Exception( code => 'XMLBLASTER_ERROR',
143 info => [ __FILE__ . ' at Line ' . __LINE__,
144 'Need a valid key for querying message !'
145 ]
146 ) );
147 }
148
149 # a default Qos
150 $qos = '<qos></qos>' if( ! $qos || $qos eq '' ) ;
151
152 my $messages = $self->{'server'}->call( 'xmlBlaster.get', $self->{'sessionId'}, $key ,$qos );
153
154 return $messages ;
155
156 }#get
157
158 ############
159 # parameters :
160 # - $key : must be defined
161 # - $qos : optional
162 sub erase
163 {
164 my( $self, $key, $qos )=@_;
165
166 if( ! $key ){
167 throw( new xmlBlaster::Exception( code => 'XMLBLASTER_ERROR',
168 info => [ __FILE__ . ' at Line ' . __LINE__,
169 'Need a valid key for erasing message !'
170 ]
171 ) );
172 }
173
174 # a default Qos
175 $qos = '<qos></qos>' if( ! $qos || $qos eq '' ) ;
176
177 my $some_eraseRetQos = $self->{'server'}->call( 'xmlBlaster.erase', $self->{'sessionId'}, $key ,$qos );
178
179 return $some_eraseRetQos ;
180
181 }#erase
182
183 ##################
184 #
185 sub DESTROY
186 {
187 my( $self ) = @_;
188
189 return 1;
190
191 }#DESTROY
192
193 1;
syntax highlighted by Code2HTML, v. 0.9.1