daemon: daemon/perl/lib/AppSwitch Config.pm

[<app...@li...>]

jgsmith     01/07/21 17:35:55

  Added:       perl/lib/AppSwitch Config.pm
  Log:
  Initial commit - no filters yet
  
  Revision  Changes    Path
  1.1                  daemon/perl/lib/AppSwitch/Config.pm
  
  Index: Config.pm
  ===================================================================
  package AppSwitch::Config;
  
  use 5.006;
  
  use Carp;
  use XML::Parser;
  use XML::Parser::EasyTree;
  
  =head1 NAME
  
  AppSwitch::Config
  
  =head1 SYNOPSIS
  
   my $config = get AppSwitch::Config q(filename);
  
   put $config q(filename);
   $config -> put();
  
  =head1 DESCRIPTION
  
  AppSwitch::Config will read and write XML configuration files for the
  AppSwitch daemon.
  
  An example configuration file:
  
    <configuration>
      <echo>
        <url>http://echo.jamesmith.com/rpc/echo.php</url>
        <filter type=accept>
          <content>^Help!</content>
        </filter>
      </echo>
      <echo>
        <url>http://echo.ookook.org/rpc/echo.php</url>
        <filter type=reject>
          <content>me!$</content>
        </filter>
      </echo>
    </configuration>
  
  Note that filters are not yet supported by AppSwitch::Config.
  
  =head1 METHODS
  
  =over 4
  
  =item get AppSwitch::Config q(filename)
  
  This will parse the named file and return a hash structure with with
  the service names as keys pointing to hashes indexed by the URL of the
  service provider.
  
  =item $config -> put([q(filename)]);
  
  This will output an XML configuration either to STDOUT (if no filename
  is given) or to the named file.  The output is suitable for reading
  with the C<get> method.
  
  =back
  
  =head1 SEE ALSO
  
  L<AppSwitch::Daemon>,
  L<AppSwitch::Services>.
  
  =head1 AUTHOR
  
  James Smith <jg...@ja...>
  
  =head1 COPYRIGHT
  
  Copyright (C) 2001  James Smith
  
  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions
  are met:
  
  1. Redistributions of source code must retain the above copyright
  notice, this list of conditions and the following disclaimer.
  
  2. Redistributions in binary form must reproduce the above copyright
  notice, this list of conditions and the following disclaimer in the
  documentation and/or other materials provided with the distribution.
  
  3. Neither the name of the Project nor the names of its contributors
  may be used to endorse or promote products derived from this
  software without specific prior written permission.
  
  =cut
  
  sub get {
      my $class = shift;
      my $file = shift;
  
      local($XML::Parser::EasyTree::Noempty) = 1;
  
      my $parser = new XML::Parser(Style => 'EasyTree');
      my $config = $parser -> parsefile($file);
  
      my $self = bless { }, (ref $class || $class);
  
      foreach my $s (@{$config}) {
          next unless $s->{name} eq "configuration";
          $config = $s -> {content};
          last;
      }
  
      foreach my $s (@{$config}) {
          my $type = $s -> {name};
          my $info = { };
          foreach my $t (@{$s -> {content}}) {
              next unless @{$t -> {content}} == 1 && $t -> {content}[0]{type} eq "t";
              $info->{$t -> {name}} = $t -> {content}[0]{content};
          }
          next unless $info -> {url};
          my $url = $info -> {url};
          delete $info -> {url};
          $self -> {$type} -> {$url} = $info;
      }
  
      return $self;
  }
  
  sub put {
      my $self = shift;
      my $file = shift;
  
      my $fh;
  
      if($file) {
          open $fh, "> $file" or croak "Unable to open $file: $!";
      } else {
          $fh = *STDOUT;
      }
  
      my($service, $config, $url, $info);
  
      print $fh "<configuration>\n";
      while(($service, $config) = each %{$self}) {
          while(($url, $info) = each %{$config}) {
              print $fh "  <$service>\n    <url>$url</url>\n",
                        join "", 
                        map { "    <$_>$$info{$_}</$_>\n" } 
                        keys %{$info};
              print $fh "  </$service>\n";
          }
      }
  
      print $fh "</configuration>\n";
  
      close $fh;
  }
  
  1;