From: Ken Youens-Clark Date: Thu, 21 Aug 2003 00:46:31 +0000 (+0000) Subject: Moved to "XML/SQLFairy.pm." X-Git-Tag: v0.04~266 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6746fe3c0dfbf24826fe9fa691d55aa21fba4931;p=dbsrgits%2FSQL-Translator.git Moved to "XML/SQLFairy.pm." --- diff --git a/lib/SQL/Translator/Producer/SqlfXML.pm b/lib/SQL/Translator/Producer/SqlfXML.pm deleted file mode 100644 index b5623ed..0000000 --- a/lib/SQL/Translator/Producer/SqlfXML.pm +++ /dev/null @@ -1,248 +0,0 @@ -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 , -# darren chamberlain , -# Chris Mungall , -# Mark Addison . -# -# 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 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. - - - - foo - 1 -
- - - -
- -=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'" : ""); - 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 Ekclark@cpan.orgE, -Darren Chamberlain Edarren@cpan.orgE, -Mark Addison Emark.addison@itn.co.ukE. - -=head1 SEE ALSO - -perl(1), SQL::Translator, SQL::Translator::Parser::SqlfXML, -SQL::Translator::Schema, XML::Writer. - -=cut