package InfoSys::FreeDB::Response::Motd; use 5.006; use base qw( InfoSys::FreeDB::Response ); use strict; use warnings; use AutoLoader qw(AUTOLOAD); use Error qw(:try); use InfoSys::FreeDB::Response qw(:line_parse); # Used by _initialize our %DEFAULT_VALUE = ( 'message_text' => '', ); # Package version our ($VERSION) = '$Revision: 0.92 $' =~ /\$Revision:\s+([^\s]+)/; 1; __END__ =head1 NAME InfoSys::FreeDB::Response::Motd - FreeDB motd response =head1 SYNOPSIS require InfoSys::FreeDB; # Create a HTTP connection my $fact = InfoSys::FreeDB->new(); my $conn = $fact->create_connection( { client_name => 'testing-InfoSys::FreeDB', client_version => $InfoSys::FreeDB::VERSION, } ); # Get motd from FreeDB my $res = $conn->motd(); # Write the motd to STDERR use IO::Handle; my $fh = IO::Handle->new_from_fd( fileno(STDERR), 'w' ); $fh->print( $res->get_message_text(), "\n" ); =head1 ABSTRACT FreeDB motd response =head1 DESCRIPTION C contains information about FreeDB motd responses. =head1 CONSTRUCTOR =over =item new(OPT_HASH_REF) Creates a new C object. C is a hash reference used to pass initialization options. C is mandatory. On error an exception C is thrown. Options for C may include: =over =item B> Passed to L. =item B> Passed to L. Defaults to B<''>. =back Options for C inherited through package B> may include: =over =item B> Passed to L. Mandatory option. =item B> Passed to L. =item B> Passed to L. Mandatory option. =back =item new_from_content_ref(CONTENT_REF) Creates a new C object from the specified content reference. C is a string reference. On error an exception C is thrown. =back =head1 METHODS =over =item get_code() This method is inherited from package C. Returns the response code. =item get_date() Returns the date the message text was modified. =item get_message_text() Returns the message text. =item get_result() This method is inherited from package C. Returns the response result text. =item is_error() This method is inherited from package C. Returns whether the response has an error or not. =item set_code(VALUE) This method is inherited from package C. Set the response code. C is the value. On error an exception C is thrown. =item set_date(VALUE) Set the date the message text was modified. C is the value. On error an exception C is thrown. =item set_error(VALUE) This method is inherited from package C. State that the response has an error. C is the value. On error an exception C is thrown. =item set_message_text(VALUE) Set the message text. C is the value. Default value at initialization is C<>. On error an exception C is thrown. =item set_result(VALUE) This method is inherited from package C. Set the response result text. C is the value. On error an exception C is thrown. =back =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L =head1 BUGS None known (yet.) =head1 HISTORY First development: September 2003 Last update: December 2003 =head1 AUTHOR Vincenzo Zocca =head1 COPYRIGHT Copyright 2003 by Vincenzo Zocca =head1 LICENSE This file is part of the C module hierarchy for Perl by Vincenzo Zocca. The InfoSys::FreeDB module hierarchy is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The InfoSys::FreeDB module hierarchy is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the InfoSys::FreeDB module hierarchy; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =cut sub new_from_content_ref { my $class = shift; my $content_ref = shift; # Convert $opt->{content_ref} to @content_ref my @content_ref = split(/[\n\r]+/, ${$content_ref} ); # Parse first line my $line = shift(@content_ref); my ($code, $tail) = $line =~ /$CODE_RX/; defined ($code) || throw Error::Simple ('ERROR: InfoSys::FreeDB::Response::Motd::new_from_content_ref, first line of specified \'content_ref\' does not contain a code.'); my %opt; my @tail = split(/\s+/, $tail, 4); if ($code == 210) { pop(@content_ref); %opt = ( code => $code, result => 'Last modified', date => $tail[2], message_text => join("\n", @content_ref), ); } elsif ($code == 401) { %opt = ( code => $code, result => 'No message of the day available', ); } else { throw Error::Simple ("ERROR: InfoSys::FreeDB::Response::Motd::new_from_content_ref, unknown code '$code' returned. Allowed codes are 210 and 401."); } # Create a new object and return it return( $class->new( \%opt ) ); } sub _initialize { my $self = shift; my $opt = defined($_[0]) ? shift : {}; # Check $opt ref($opt) eq 'HASH' || throw Error::Simple("ERROR: InfoSys::FreeDB::Response::Motd::_initialize, first argument must be 'HASH' reference."); # date, SINGLE exists( $opt->{date} ) && $self->set_date( $opt->{date} ); # message_text, SINGLE, with default value $self->set_message_text( exists( $opt->{message_text} ) ? $opt->{message_text} : $DEFAULT_VALUE{message_text} ); # Call the superclass' _initialize $self->SUPER::_initialize($opt); # Return $self return($self); } sub _value_is_allowed { return(1); } sub get_date { my $self = shift; return( $self->{InfoSys_FreeDB_Response_Motd}{date} ); } sub get_message_text { my $self = shift; return( $self->{InfoSys_FreeDB_Response_Motd}{message_text} ); } sub set_date { my $self = shift; my $val = shift; # Check if isa/ref/rx/value is allowed &_value_is_allowed( 'date', $val ) || throw Error::Simple("ERROR: InfoSys::FreeDB::Response::Motd::set_date, the specified value '$val' is not allowed."); # Assignment $self->{InfoSys_FreeDB_Response_Motd}{date} = $val; } sub set_message_text { my $self = shift; my $val = shift; # Check if isa/ref/rx/value is allowed &_value_is_allowed( 'message_text', $val ) || throw Error::Simple("ERROR: InfoSys::FreeDB::Response::Motd::set_message_text, the specified value '$val' is not allowed."); # Assignment $self->{InfoSys_FreeDB_Response_Motd}{message_text} = $val; }