appswitch-commits Mailing List for Application Switch (Page 2)

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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;

appswitch-commits Mailing List for Application Switch (Page 2)

appswitch-commits — All CVS commits are posted to this list as context diffs.