+++ /dev/null
-package SQL::Translator::Producer::SqlfXML;
-
-# -------------------------------------------------------------------
-# $Id: SqlfXML.pm,v 1.6 2003-08-20 22:54:25 kycl4rk Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
-# darren chamberlain <darren@cpan.org>,
-# Chris Mungall <cjm@fruitfly.org>,
-# Mark Addison <mark.addison@itn.co.uk>.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; version 2.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-# 02111-1307 USA
-# -------------------------------------------------------------------
-
-=pod
-
-=head1 NAME
-
-SQL::Translator::Producer::SqlfXML - SQLFairy's default XML format
-
-=head1 SYNOPSIS
-
- use SQL::Translator;
-
- my $t = SQL::Translator->new(
- from => 'MySQL',
- to => 'SqlfXML',
- filename => 'schema.sql',
- show_warnings => 1,
- add_drop_table => 1,
- );
-
- print $t->translate;
-
-=head1 ARGS
-
-Takes the following extra producer args.
-
-=over 4
-
-=item * emit_empty_tags
-
-Default is false, set to true to emit <foo></foo> style tags for undef values
-in the schema.
-
-=item * attrib_values
-
-Set true to use attributes for values of the schema objects instead of tags.
-
- <!-- attrib_values => 0 -->
- <table>
- <name>foo</name>
- <order>1</order>
- </table>
-
- <!-- attrib_values => 1 -->
- <table name="foo" order="1">
- </table>
-
-=back
-
-=head1 DESCRIPTION
-
-Creates XML output of a schema.
-
-=cut
-
-use strict;
-use vars qw[ $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
-
-use Exporter;
-use base qw(Exporter);
-@EXPORT_OK = qw(produce);
-
-use IO::Scalar;
-use SQL::Translator::Utils qw(header_comment debug);
-use XML::Writer;
-
-my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
-my $Name = 'sqlt';
-my $PArgs;
-
-sub produce {
- my $translator = shift;
- my $schema = $translator->schema;
- $PArgs = $translator->producer_args;
- my $io = IO::Scalar->new;
- my $xml = XML::Writer->new(
- OUTPUT => $io,
- NAMESPACES => 1,
- PREFIX_MAP => { $Namespace => $Name },
- DATA_MODE => 1,
- DATA_INDENT => 2,
- );
-
- $xml->xmlDecl('UTF-8');
- $xml->comment(header_comment('', ''));
- $xml->startTag([ $Namespace => 'schema' ]);
-
- #
- # Table
- #
- for my $table ( $schema->get_tables ) {
- debug "Table:",$table->name;
- xml_obj($xml, $table,
- tag => "table", methods => [qw/name order/], end_tag => 0 );
-
- #
- # Fields
- #
- $xml->startTag( [ $Namespace => 'fields' ] );
- for my $field ( $table->get_fields ) {
- debug " Field:",$field->name;
- xml_obj($xml, $field,
- tag =>"field",
- end_tag => 1,
- methods =>[qw/name data_type default_value is_auto_increment
- is_primary_key is_nullable is_foreign_key order size
- /],
- );
- }
- $xml->endTag( [ $Namespace => 'fields' ] );
-
- #
- # Indices
- #
- $xml->startTag( [ $Namespace => 'indices' ] );
- for my $index ( $table->get_indices ) {
- debug "Index:",$index->name;
- xml_obj($xml, $index,
- tag => "index",
- end_tag => 1,
- methods =>[qw/fields name options type/],
- );
- }
- $xml->endTag( [ $Namespace => 'indices' ] );
-
- #
- # Constraints
- #
- $xml->startTag( [ $Namespace => 'constraints' ] );
- for my $index ( $table->get_constraints ) {
- debug "Constraint:",$index->name;
- xml_obj($xml, $index,
- tag => "constraint",
- end_tag => 1,
- methods =>[qw/
- deferrable expression fields match_type name
- options on_delete on_update reference_fields
- reference_table type/],
- );
- }
- $xml->endTag( [ $Namespace => 'constraints' ] );
-
- $xml->endTag( [ $Namespace => 'table' ] );
- }
-
- $xml->endTag([ $Namespace => 'schema' ]);
- $xml->end;
-
- return $io;
-}
-
-# -------------------------------------------------------------------
-sub xml_obj {
- my ($xml, $obj, %args) = @_;
- my $tag = $args{'tag'} || '';
- my $end_tag = $args{'end_tag'} || '';
- my $attrib_values = $PArgs->{'attrib_values'} || '';
- my @meths = @{ $args{'methods'} };
- my $empty_tag = 0;
-
- if ( $attrib_values and $end_tag ) {
- $empty_tag = 1;
- $end_tag = 0;
- }
-
- if ( $attrib_values ) {
- my %attr = map {
- my $val = $obj->$_;
- ($_ => ref($val) eq 'ARRAY' ? join(', ', @$val) : $val);
- } @meths;
- foreach ( keys %attr ) { delete $attr{$_} unless defined $attr{$_}; }
- $empty_tag ? $xml->emptyTag( [ $Namespace => $tag ], %attr )
- : $xml->startTag( [ $Namespace => $tag ], %attr );
- }
- else {
- $xml->startTag( [ $Namespace => $tag ] );
- xml_objAttr( $xml, $obj, @meths );
- }
-
- $xml->endTag( [ $Namespace => $tag ] ) if $end_tag;
-}
-
-# -------------------------------------------------------------------
-# Takes an XML writer, a Schema::* object and a list of methods and
-# adds the XML for those methods.
-#
-sub xml_objAttr {
- my ($xml, $obj, @methods) = @_;
- my $emit_empty = $PArgs->{'emit_empty_tags'};
-
- for my $method ( @methods ) {
- my $val = $obj->$method;
- debug " ".ref($obj)."->$method=",
- (defined $val ? "'$val'" : "<UNDEF>");
- next unless $emit_empty || defined $val;
- $val = '' if not defined $val;
- $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
- debug " Adding Attr:".$method."='",$val,"'";
- $xml->dataElement( [ $Namespace => $method ], $val );
- }
-}
-
-1;
-
-# -------------------------------------------------------------------
-# The eyes of fire, the nostrils of air,
-# The mouth of water, the beard of earth.
-# William Blake
-# -------------------------------------------------------------------
-
-=pod
-
-=head1 AUTHORS
-
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
-Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
-Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
-
-=head1 SEE ALSO
-
-perl(1), SQL::Translator, SQL::Translator::Parser::SqlfXML,
-SQL::Translator::Schema, XML::Writer.
-
-=cut
projects / dbsrgits/SQL-Translator.git / commitdiff