1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
#!/usr/local/bin/perl -w
=head1 NAME
stag-autotemplate.pl - Generates Stag SQL Templates files
=head1 SYNOPSIS
stag-autotemplate.pl \
-s my-schema-name -dir ./templates my-sample-data.xml
stag-autotemplate.pl \
-s my-schema-name -dir ./templates -no_pp my-stagschema.sxpr
=head1 DESCRIPTION
Generates Stag SQL Templates files based on sample data or a stag-schema
See the script
stag-autoschema.pl
for generating stag schemas from sample data
=head1 ARGUMENTS
=over
=item -no_pp
do not pre-process (the input is a stag schema, not a sample data file)
=item -dir
directory in which to write autogenerated templates
=back
=cut
use strict;
use Carp;
use Data::Stag qw(:all);
use DBIx::DBStag;
use FileHandle;
use Getopt::Long;
my $parser = "";
my $handler = "";
my $mapf;
my $tosql;
my $toxml;
my $toperl;
my $debug;
my $help;
my @link = ();
my $ofn;
my $no_pp;
my $dir = '.';
my $schema_name;
GetOptions(
"help|h"=>\$help,
"parser|format|p=s" => \$parser,
"handler|writer|w=s" => \$handler,
"xml"=>\$toxml,
"perl"=>\$toperl,
"debug"=>\$debug,
"link|l=s@"=>\@link,
"transform|t=s"=>\$ofn,
"schema|s=s"=>\$schema_name,
"no_pp|n"=>\$no_pp,
"dir|d=s"=>\$dir,
);
if ($help) {
system("perldoc $0");
exit 0;
}
my $db = DBIx::DBStag->new;
if (!$schema_name) {
print STDERR "You should consider using the -schema|s option to set schema name\n";
}
my $fn = shift @ARGV;
die "max 1 file" if @ARGV;
autotemplate($fn);
sub autotemplate {
my $fn = shift;
my $tree =
Data::Stag->parse($fn,
$parser);
my $schema = $tree;
if (!$no_pp) {
$schema = $tree->autoschema;
}
my @tts = $db->autotemplate($schema);
foreach my $tt (@tts) {
my $base = $schema_name || 'AUTO';
my $fn = "$dir/$base-$tt->[0].stg";
open(F, ">$fn") || die("cannot open $fn");
$tt->[1] =~ s/\nschema:/\nschema: $schema_name/ if $schema_name;
print F "$tt->[1]";
close(F);
}
}
|
