source: perl/modules/Jabber/lib/Net/Jabber/Log.pm @ c2bed55

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since c2bed55 was c2bed55, checked in by Nelson Elhage <nelhage@mit.edu>, 14 years ago
Moving Net::Jabber into Jabber.par
  • Property mode set to 100644
File size: 8.9 KB
Line 
1##############################################################################
2#
3#  This library is free software; you can redistribute it and/or
4#  modify it under the terms of the GNU Library General Public
5#  License as published by the Free Software Foundation; either
6#  version 2 of the License, or (at your option) any later version.
7#
8#  This library is distributed in the hope that it will be useful,
9#  but WITHOUT ANY WARRANTY; without even the implied warranty of
10#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11#  Library General Public License for more details.
12#
13#  You should have received a copy of the GNU Library General Public
14#  License along with this library; if not, write to the
15#  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
16#  Boston, MA  02111-1307, USA.
17#
18#  Jabber
19#  Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
20#
21##############################################################################
22
23package Net::Jabber::Log;
24
25=head1 NAME
26
27Net::Jabber::Log - Jabber Log Module
28
29=head1 SYNOPSIS
30
31  Net::Jabber::Log is a companion to the Net::Jabber module.
32  It provides the user a simple interface to set and retrieve all
33  parts of a Jabber Log.
34
35=head1 DESCRIPTION
36
37  To initialize the Log with a Jabber <log/> you must pass it the
38  XML::Parser Tree array.  For example:
39
40    my $log = Net::Jabber::Log->new(@tree);
41
42  There has been a change from the old way of handling the callbacks.
43  You no longer have to do the above, a Net::Jabber::Log object is passed
44  to the callback function for the log:
45
46    use Net::Jabber;
47
48    sub log {
49      my ($Log) = @_;
50      .
51      .
52      .
53    }
54
55  You now have access to all of the retrieval functions available.
56
57  To create a new log to send to the server:
58
59    use Net::Jabber;
60
61    $Log = Net::Jabber::Log->new();
62
63  Now you can call the creation functions below to populate the tag before
64  sending it.
65
66  For more information about the array format being passed to the CallBack
67  please read the Net::Jabber::Client documentation.
68
69=head2 Retrieval functions
70
71    $from       = $Log->GetFrom();
72    $fromJID    = $Log->GetFrom("jid");
73    $type       = $Log->GetType();
74    $data       = $Log->GetData();
75
76    $str        = $Log->GetXML();
77    @log        = $Log->GetTree();
78
79=head2 Creation functions
80
81    $Log->SetLog(type=>"error",
82                 from=>"users.jabber.org",
83                 data=>"The moon is full... I can't run anymore.");
84    $Log->SetFrom("foo.jabber.org");
85    $Log->SetType("warn");
86    $Log->SetData("I can't find a config file.  Using defaults.");
87
88=head2 Test functions
89
90    $test = $Log->DefinedFrom();
91    $test = $Log->DefinedType();
92
93=head1 METHODS
94
95=head2 Retrieval functions
96
97  GetFrom()      -  returns either a string with the Jabber Identifier,
98  GetFrom("jid")    or a Net::Jabber::JID object for the person who
99                    sent the <log/>.  To get the JID object set
100                    the string to "jid", otherwise leave blank for the
101                    text string.
102
103  GetType() - returns a string with the type <log/> this is.
104
105  GetData() - returns a string with the cdata of the <log/>.
106
107  GetXML() - returns the XML string that represents the <log/>.
108             This is used by the Send() function in Client.pm to send
109             this object as a Jabber Log.
110
111  GetTree() - returns an array that contains the <log/> tag
112              in XML::Parser Tree format.
113
114=head2 Creation functions
115
116  SetLog(from=>string|JID, - set multiple fields in the <log/>
117         type=>string,       at one time.  This is a cumulative
118         data=>string)       and over writing action.  If you set
119                             the "from" attribute twice, the second
120                             setting is what is used.  If you set
121                             the type, and then set the data
122                             then both will be in the <log/>
123                             tag.  For valid settings read the
124                             specific Set functions below.
125
126  SetFrom(string) - sets the from attribute.  You can either pass a string
127  SetFrom(JID)      or a JID object.  They must be valid Jabber
128                    Identifiers or the server will return an error log.
129                    (ie.  jabber:bob@jabber.org/Silent Bob, etc...)
130
131  SetType(string) - sets the type attribute.  Valid settings are:
132
133                    notice     general logging
134                    warn       warning
135                    alert      critical error (can still run but not
136                               correctly)
137                    error      fatal error (cannot run anymore)
138
139  SetData(string) - sets the cdata of the <log/>.
140
141=head2 Test functions
142
143  DefinedFrom() - returns 1 if the from attribute is defined in the
144                  <log/>, 0 otherwise.
145
146  DefinedType() - returns 1 if the type attribute is defined in the
147                  <log/>, 0 otherwise.
148
149=head1 AUTHOR
150
151By Ryan Eatmon in May of 2000 for http://jabber.org..
152
153=head1 COPYRIGHT
154
155This module is free software; you can redistribute it and/or modify
156it under the same terms as Perl itself.
157
158=cut
159
160require 5.003;
161use strict;
162use Carp;
163use vars qw($VERSION $AUTOLOAD %FUNCTIONS);
164
165$VERSION = "2.0";
166
167sub new
168{
169    my $proto = shift;
170    my $class = ref($proto) || $proto;
171    my $self = { };
172   
173    $self->{VERSION} = $VERSION;
174    $self->{TIMESTAMP} = &Net::Jabber::GetTimeStamp("local");
175
176    bless($self, $proto);
177
178    $self->{DEBUG} = Net::Jabber::Debug->new(usedefault=>1,
179                                             header=>"NJ::Log");
180
181    if ("@_" ne (""))
182    {
183        if (ref($_[0]) eq "Net::Jabber::Log")
184        {
185            return $_[0];
186        }
187        else
188        {
189            my @temp = @_;
190            $self->{LOG} = \@temp;
191        }
192    }
193    else
194    {
195        $self->{LOG} = [ "log" , [{}]];
196    }
197
198    return $self;
199}
200
201
202##############################################################################
203#
204# AUTOLOAD - This function calls the delegate with the appropriate function
205#            name and argument list.
206#
207##############################################################################
208sub AUTOLOAD
209{
210    my $self = shift;
211    return if ($AUTOLOAD =~ /::DESTROY$/);
212    $AUTOLOAD =~ s/^.*:://;
213    my ($type,$value) = ($AUTOLOAD =~ /^(Get|Set|Defined)(.*)$/);
214    $type = "" unless defined($type);
215    my $treeName = "LOG";
216   
217    return "log" if ($AUTOLOAD eq "GetTag");
218    return &XML::Stream::BuildXML(@{$self->{$treeName}}) if ($AUTOLOAD eq "GetXML");
219    return @{$self->{$treeName}} if ($AUTOLOAD eq "GetTree");
220    return &Net::Jabber::Get($self,$self,$value,$treeName,$FUNCTIONS{get}->{$value},@_) if ($type eq "Get");
221    return &Net::Jabber::Set($self,$self,$value,$treeName,$FUNCTIONS{set}->{$value},@_) if ($type eq "Set");
222    return &Net::Jabber::Defined($self,$self,$value,$treeName,$FUNCTIONS{defined}->{$value},@_) if ($type eq "Defined");
223    return &Net::Jabber::debug($self,$treeName) if ($AUTOLOAD eq "debug");
224    &Net::Jabber::MissingFunction($self,$AUTOLOAD);
225}
226
227
228$FUNCTIONS{get}->{From} = ["value","","from"];
229$FUNCTIONS{get}->{Type} = ["value","","type"];
230$FUNCTIONS{get}->{Data} = ["value","",""];
231
232$FUNCTIONS{set}->{Type} = ["single","","","type","*"];
233$FUNCTIONS{set}->{Data} = ["single","","*","",""];
234
235$FUNCTIONS{defined}->{From} = ["existence","","from"];
236$FUNCTIONS{defined}->{Type} = ["existence","","type"];
237
238
239##############################################################################
240#
241# GetXML -  returns the XML string that represents the data in the XML::Parser
242#          Tree.
243#
244##############################################################################
245sub GetXML
246{
247    my $self = shift;
248    $self->MergeX();
249    return &XML::Stream::BuildXML(@{$self->{LOG}});
250}
251
252
253##############################################################################
254#
255# GetTree - returns the XML::Parser Tree that is stored in the guts of
256#              the object.
257#
258##############################################################################
259sub GetTree
260{
261    my $self = shift;
262    $self->MergeX();
263    return %{$self->{LOG}};
264}
265
266
267##############################################################################
268#
269# SetLog - takes a hash of all of the things you can set on a <log/>
270#              and sets each one.
271#
272##############################################################################
273sub SetLog
274{
275    my $self = shift;
276    my %log;
277    while($#_ >= 0) { $log{ lc pop(@_) } = pop(@_); }
278
279    $self->SetFrom($log{from}) if exists($log{from});
280    $self->SetType($log{type}) if exists($log{type});
281    $self->SetData($log{data}) if exists($log{data});
282}
283
284
285##############################################################################
286#
287# SetFrom - sets the from attribute in the <log/>
288#
289##############################################################################
290sub SetFrom
291{
292    my $self = shift;
293    my ($from) = @_;
294    if (ref($from) eq "Net::Jabber::JID")
295    {
296        $from = $from->GetJID("full");
297    }
298    return unless ($from ne "");
299    &XML::Stream::SetXMLData("single",$self->{LOG},"","",{from=>$from});
300}
301
302
3031;
Note: See TracBrowser for help on using the repository browser.