Daemon.pm 2.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596
  1. #
  2. # Copyright (C) 1998 Ken MacLeod
  3. # Frontier::Daemon is free software; you can redistribute it
  4. # and/or modify it under the same terms as Perl itself.
  5. #
  6. # $Id: Daemon.pm,v 1.5 2001/10/03 01:30:54 kmacleod Exp $
  7. #
  8. # NOTE: see Net::pRPC for a Perl RPC implementation
  9. ###
  10. ### NOTE: $self is inherited from HTTP::Daemon and the weird access
  11. ### comes from there (`${*$self}').
  12. ###
  13. use strict;
  14. package Frontier::Daemon;
  15. use vars qw{@ISA};
  16. @ISA = qw{HTTP::Daemon};
  17. use Frontier::RPC2;
  18. use HTTP::Daemon;
  19. use HTTP::Status;
  20. sub new {
  21. my $class = shift; my %args = @_;
  22. my $self = $class->SUPER::new(%args);
  23. return undef unless $self;
  24. ${*$self}{'methods'} = $args{'methods'};
  25. ${*$self}{'decode'} = new Frontier::RPC2 'use_objects' => $args{'use_objects'};
  26. ${*$self}{'response'} = new HTTP::Response 200;
  27. ${*$self}{'response'}->header('Content-Type' => 'text/xml');
  28. my $conn;
  29. while ($conn = $self->accept) {
  30. my $rq = $conn->get_request;
  31. if ($rq) {
  32. if ($rq->method eq 'POST' && $rq->url->path eq '/RPC2') {
  33. ${*$self}{'response'}->content(${*$self}{'decode'}->serve($rq->content, ${*$self}{'methods'}));
  34. $conn->send_response(${*$self}{'response'});
  35. } else {
  36. $conn->send_error(RC_FORBIDDEN);
  37. }
  38. }
  39. $conn->close;
  40. $conn = undef; # close connection
  41. }
  42. return $self;
  43. }
  44. =head1 NAME
  45. Frontier::Daemon - receive Frontier XML RPC requests
  46. =head1 SYNOPSIS
  47. use Frontier::Daemon;
  48. Frontier::Daemon->new(methods => {
  49. 'rpcName' => \&sub_name,
  50. ...
  51. });
  52. =head1 DESCRIPTION
  53. I<Frontier::Daemon> is an HTTP/1.1 server that listens on a socket for
  54. incoming requests containing Frontier XML RPC2 method calls.
  55. I<Frontier::Daemon> is a subclass of I<HTTP::Daemon>, which is a
  56. subclass of I<IO::Socket::INET>.
  57. I<Frontier::Daemon> takes a `C<methods>' parameter, a hash that maps
  58. an incoming RPC method name to reference to a subroutine.
  59. I<Frontier::Daemon> takes a `C<use_objects>' parameter that if set to
  60. a non-zero value will convert incoming E<lt>intE<gt>, E<lt>i4E<gt>,
  61. E<lt>floatE<gt>, and E<lt>stringE<gt> values to objects instead of
  62. scalars. See int(), float(), and string() in Frontier::RPC2 for more
  63. details.
  64. =head1 SEE ALSO
  65. perl(1), HTTP::Daemon(3), IO::Socket::INET(3), Frontier::RPC2(3)
  66. <http://www.scripting.com/frontier5/xml/code/rpc.html>
  67. =head1 AUTHOR
  68. Ken MacLeod <[email protected]>
  69. =cut
  70. 1;