File Coverage

blib/lib/CGI/ToXML.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

#!/usr/bin/perl -w
package CGI::ToXML;

#=============================================================================
#
# $Id: ToXML.pm,v 0.02 2002/02/05 01:09:18 mneylon Exp $
# $Revision: 0.02 $
# $Author: mneylon $
# $Date: 2002/02/05 01:09:18 $
# $Log: ToXML.pm,v $
# Revision 0.02  2002/02/05 01:09:18  mneylon
# Slight fix in POD docs
#
# Revision 0.01  2002/02/03 17:11:44  mneylon
# Initial release to Perlmonks
#
#
#=============================================================================

use strict;
use XML::Simple;

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

sub CGItoXML {
  my ( $cgi, %options ) = @_;
  if ( ! $cgi->isa( "CGI" ) ) {
    warn "CGItoXML: Object isn't a CGI object, cannot convert";
    return undef;
  }

  # Determine which parameters we keep or not
  my @paramlist = $cgi->param;

  # Exclude what we can first...
  if ( exists $options{ exclude } ) {
    my %exclude_hash; $exclude_hash{ $_ }++ foreach @{ $options{ exclude } };
    @paramlist = grep { !exists( $exclude_hash{ $_ } ) } @paramlist;
  }

  # Include what we can...
  if ( exists $options{ include } ) {
    my %include_hash; $include_hash{ $_ }++ foreach @{ $options{ include } };
    @paramlist = grep { exists( $include_hash{ $_ } ) } @paramlist;
  }

  # Set up the hashes to be used for conversion

  my @params;
  foreach my $param ( @paramlist ) {
    my @values;
    # Ensure we get values as an array
    foreach my $value ( $cgi->param( $param ) ) {
      push @values, $value;
    }
    push @params, { parameter => { name => $param,
				   value => \@values } };
  }

  my %cgi_hash = ( cgi => {
			   generator => "CGI::toXML",
			   version => $VERSION,
			   parameter => \@params } );

  return XMLout( \%cgi_hash, rootname => undef ) ;
}


1;
__END__