File Coverage

blib/lib/XML/Generator/CGI.pm

Criterion	Covered	Total	%
statement	20	66	30.3
branch	0	10	0.0
condition	0	3	0.0
subroutine	6	10	60.0
pod	2	2	100.0
total	28	91	30.7

#!/usr/bin/perl -w

#=============================================================================
#
# $Id: CGI.pm,v 0.01 2002/02/24 20:41:37 mneylon Exp $
# $Revision: 0.01 $
# $Author: mneylon $
# $Date: 2002/02/24 20:41:37 $
# $Log: CGI.pm,v $
# Revision 0.01  2002/02/24 20:41:37  mneylon
# Initial Release
#
#
#=============================================================================

package XML::Generator::CGI;

use strict;
use CGI;
use XML::SAX::Base;

BEGIN {
  use Exporter   ();
  use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  $VERSION     = sprintf( "%d.%02d", q( $Revision: 0.01 $ ) =~ /\s(\d+)\.(\d+)/ );
  @ISA         = qw(Exporter XML::SAX::Base);
  @EXPORT      = qw();
  @EXPORT_OK   = qw( );
  %EXPORT_TAGS = (  );
}

my %defaults = (
		RootElement => "cgi",
		ParameterElement => "parameter",
		ValueElement => "value",
		CookieElement => "cookie",
		Cookies => 1
);

sub new {
  my ( $proto, %args ) = @_;
  my $class = ref( $proto ) || $proto;
  my $self = { %defaults, %args };
  bless ( $self, $class );
  return $self;
}

sub parsecgi {
  my $self = shift;
  my $arg = shift;
  if ( UNIVERSAL::isa( $arg, "CGI" ) ) {
    $self->_parse_cgi( $arg );
  } elsif ( defined $arg ) {
    my $cgi = new CGI( $arg );
    $self->_parse_cgi( $cgi );
  } else {
    my $cgi = new CGI;
    $self->_parse_cgi( $cgi );
  }
}

sub _parse_cgi {
  my ( $self, $cgi ) = @_;

  $self->SUPER::start_document( {} );

  $self->SUPER::start_element( { Name => $self->{ RootElement },
				 Attributes => { version => $VERSION,
						 generator => "XML::Generator::CGI"
					       }
			       }
			     );

  my @params = $self->_distill_params( $cgi->param() );

  foreach my $param ( @params ) {
    $self->SUPER::start_element( { Name => $self->{ ParameterElement },
				   Attributes => { name => $param }
				 }
			       );
    foreach my $value ( $cgi->param( $param ) ) {
      $self->SUPER::start_element( { Name => $self->{ ValueElement } } );
      $self->SUPER::characters( { Data => $value } );
      $self->SUPER::end_element( { Name => $self->{ ValueElement } } );
    }

    $self->SUPER::end_element( { Name => $self->{ ParameterElement } } );
  }

  $self->SUPER::end_element( { Name => $self->{ RootElement } } );

  if ( $self->{ Cookies } ) {
    foreach my $cookie ( $cgi->cookie() ) {
      $self->SUPER::start_element( { Name => $self->{ CookieElement },
				     Attributes => { name => $cookie }
				   }
				 );
      $self->SUPER::characters( { Data => $cgi->cookie( $cookie ) } );
      $self->SUPER::end_element( { Name => $self->{ CookieElement } } );
    }
  }

  $self->SUPER::end_document( {} );
}

sub _distill_params {
  my $self = shift;
  my @params = @_;

  if ( $self->{ Exclude } ) {
    my %exclude_hash = map { $_ => 1 } @{ $self->{ Exclude } };
    @params = grep { ! exists $exclude_hash{ $_ } } @params;
  }

  if ( $self->{ Include } ) {
    my %include_hash = map { $_ => 1 } @{ $self->{ Include } };
    @params = grep { exists $include_hash{ $_ } } @params;
  }
  return @params;

}

1;
__END__