SchemaView-Plus
view release on metacpan or search on metacpan
$d->Button(-text => '>>', -command => sub {
study $ufilter2;
for (sort $list1->get(0,'end')) {
$list2->insert('end',$_) if /$ufilter2/;
delete $sources{$_};
++$targets{$_};
}
$list1->delete(0,'end');
$list1->selectionClear(0,'end');
$list2->selectionClear(0,'end');
$list1->see(0);
$list2->see(0);
})->grid(-column => 2, -row => 3);
$d->Button(-text => '>', -command => sub {
study $ufilter2;
for my $pos (sort $list1->curselection) {
my $tx = $list1->get($pos);
$list2->insert('end',$tx)
if $tx =~ /$ufilter2/;
delete $sources{$tx};
++$targets{$tx};
}
for (reverse sort $list1->curselection) {
$list1->selectionClear($_);
$list1->delete($_);
}
})->grid(-column => 2, -row => 5);
$d->Button(-text => '<', -command => sub {
study $ufilter1;
for my $pos (sort $list2->curselection) {
my $tx = $list2->get($pos);
$list1->insert('end',$tx)
if $tx =~ /$ufilter1/;
delete $targets{$tx};
++$sources{$tx};
}
for (reverse sort $list2->curselection) {
$list2->selectionClear($_);
$list2->delete($_);
}
})->grid(-column => 2, -row => 7);
$d->Button(-text => '<<', -command => sub {
study $ufilter1;
for (sort $list2->get(0,'end')) {
$list1->insert('end',$_) if /$ufilter1/;
delete $targets{$_};
++$sources{$_};
}
$list2->delete(0,'end');
$list1->selectionClear(0,'end');
$list2->selectionClear(0,'end');
$list1->see(0);
$list2->see(0);
})->grid(-column => 2, -row => 9);
$d->Label(-text => 'Available tables and views:')
->grid(-column => 1, -row => 1, -sticky => 'w');
$d->Label(-text => 'Tables and views to retrieve:')
->grid(-column => 3, -row => 1, -sticky => 'w');
$d->Label(-text => 'Filters are used only for showing in this dialog and not for retrieving objects from database.')
->grid(-column => 1, -columnspan => 3, -row => 12);
$d->gridRowconfigure(1, -weight => 0, -minsize => 30);
$d->gridRowconfigure(2, -weight => 0, -minsize => 90);
$d->gridRowconfigure(3, -weight => 0, -minsize => 30);
$d->gridRowconfigure(4, -weight => 0, -minsize => 30);
$d->gridRowconfigure(5, -weight => 0, -minsize => 30);
$d->gridRowconfigure(6, -weight => 0, -minsize => 30);
$d->gridRowconfigure(7, -weight => 0, -minsize => 30);
$d->gridRowconfigure(8, -weight => 0, -minsize => 30);
$d->gridRowconfigure(9, -weight => 0, -minsize => 30);
$d->gridRowconfigure(10, -weight => 0, -minsize => 30);
$d->gridRowconfigure(11, -weight => 0, -minsize => 30);
$d->gridRowconfigure(12, -weight => 0, -minsize => 30);
$d->gridColumnconfigure(1, -weight => 0, -minsize => 180);
$d->gridColumnconfigure(2, -weight => 0, -minsize => 50);
$d->gridColumnconfigure(3, -weight => 0, -minsize => 180);
$list1->delete(0,'end');
for (sort keys %targets) { $list2->insert('end',$_); }
$list2->see(0);
unless ($d->Show() eq 'Retrieve') {
$dbh->disconnect;
return;
}
mouse_hour($main);
my %tables = ();
for (sort keys %targets) { s/ \([TV]\)$//g; ++$tables{$_}; }
# fetching all tables and views with structure
$progress->configure(-to => 1+scalar (keys %tables),
-value => 0);
$progress->update(); my $i = 0;
# delete all fetched tables from data-structure
my @old = ();
for (@{$data{tables}}) {
push @old,$_ unless $tables{$_->{name}};
}
$data{tables} = [ @old ];
for ($catalog->tables_with_types) {
next unless exists $tables{$_->{name}};
$progress->value(++$i);
$progress->update();
my %table = ();
$table{name} = $_->{name};
$table{type} = $_->{type};
$table{schema} = $schema;
my @columns = $catalog->table_columns($_->{name});
$table{columns} = [ @columns ];
my @pk = $catalog->primary_keys($_->{name});
$table{pk} = [ @pk ];
my @unique = $catalog->unique_indexes($_->{name});
$table{unique_indexes} = [ @unique ];
my @indexes = $catalog->indexes($_->{name});
$table{indexes} = [ @indexes ];
my $xd = $x2 - $x1;
my $yd = $y2 - $y1;
unless ($xd and $yd) {
$main->messageBox(-icon => 'error', -type => 'OK',
-title => 'Print Error',
-message => 'No schema to print.');
return;
}
my $printerselect = $main->DialogBox(-title => 'Printer Select',
-buttons => [ 'OK', 'Cancel' ] );
$printerselect->Label(-text => 'Please select output device:')
->grid(-row => 0, -column => 0, -sticky => 'ew');
my $lb = $printerselect->Scrolled('Listbox', -selectmode => 'single',
-setgrid => 1, -scrollbars => 'e')
->grid(-row => 1, -column => 0, -sticky => 'nsew');
$printerselect->gridRowconfigure(0, -weight => 0, -minsize => 200);
$printerselect->gridColumnconfigure(0, -weight => 0, -minsize => 300);
$printerselect->gridRowconfigure(0, -weight => 0, -minsize => 200);
my $gv = `type -p gv 2>/dev/null`;
chomp $gv;
unless ($gv) {
my $gv = `type -p ghostview 2>/dev/null`;
chomp $gv;
}
$lb->insert('end','PostScript file');
$lb->insert('end','GhostView') if $gv;
my $printcap = new Print::Printcap;
for ($printcap->printers) { $lb->insert('end','Printer '.$_); }
return unless $printerselect->Show eq 'OK';
my @i = $lb->curselection;
my $device = $lb->get($i[0]);
$device = ':ps' if $device eq 'PostScript file';
$device = ':gv' if $device eq 'GhostView';
$device =~ s/^Printer //;
my $psop = $main->DialogBox(-title => 'PostScript Options',
-buttons => [ 'OK', 'Cancel' ] );
# Limits from GhostView (gv)
my %format_par = (
A4 => { x => 595, y => 842 },
A3 => { x => 842, y => 1191 } );
my @formats = qw/A4 A3 Fit Poster/;
my $poster = new PostScript::Poster;
my $format = '';
my $ftype = 'predefined';
my $fori = 0;
my $printx = ''; my $printy = '';
$psop->Label(-justify => 'left', -text => 'Page format:')
->grid(-column => 1, -columnspan => 2, -row => 1,
-sticky => 'w');
$psop->Radiobutton(-variable => \$ftype, -value => 'predefined',
-text => 'Predefined ', -anchor => 'w')
->grid(-column => 1, -row => 2, -sticky => 'w');
$psop->Radiobutton(-variable => \$ftype, -value => 'manual',
-text => 'Manual ', -anchor => 'w')
->grid(-column => 1, -row => 3, -sticky => 'w');
$psop->Optionmenu(-options => \@formats, -variable => \$format)
->grid(-column => 2, -row => 2, -sticky => 'ew');
$psop->Label(-justify => 'left', -text => 'X: ')
->grid(-column => 1, -row => 4, -sticky => 'e');
$psop->Entry(-textvariable => \$printx)
->grid(-column => 2, -row => 4, -sticky => 'ew');
$psop->Label(-justify => 'left', -text => 'Y: ')
->grid(-column => 1, -row => 5, -sticky => 'e');
$psop->Entry(-textvariable => \$printy)
->grid(-column => 2, -row => 5, -sticky => 'ew');
$psop->Label(-justify => 'left', -text => 'Page orientation:')
->grid(-column => 1, -columnspan => 2, -row => 7,
-sticky => 'w');
$psop->Radiobutton(-variable => \$fori, -value => 0,
-text => 'Portrait ', -anchor => 'w')
->grid(-column => 1, -row => 8, -sticky => 'ew');
$psop->Radiobutton(-variable => \$fori, -value => 1,
-text => 'Landscape ', -anchor => 'w')
->grid(-column => 2, -row => 8, -sticky => 'ew');
return unless $psop->Show eq 'OK';
my $format_big = ''; my $format_paper = '';
if ($ftype eq 'predefined' and $format eq 'Poster') {
my $pop = $main->DialogBox(-title => 'Poster Options',
-buttons => [ "OK", "Cancel" ] );
# Limits from GhostView (gv)
my @fmts_big = qw/Fit A0 A1 A2 A3 A4/;
my @fmts_paper = qw/A4 A3/;
$format_big = 'Fit';
$format_paper = 'A4';
$pop->Label(-justify => 'left',
-text => 'Format for whole schema (big):')
->grid(-column => 1, -row => 1, -sticky => 'w');
$pop->Optionmenu(-options => \@fmts_big,
-variable => \$format_big)
->grid(-column => 2, -row => 1, -sticky => 'ew');
$pop->Label(-justify => 'left',
-text => 'Paper (media) format:')
->grid(-column => 1, -row => 2, -sticky => 'w');
$pop->Optionmenu(-options => \@fmts_paper,
-variable => \$format_paper)
->grid(-column => 2, -row => 2, -sticky => 'ew');
return unless $pop->Show eq 'OK';
}
my $fn = '';
if ($device eq ':ps') {
$fn = $main->getSaveFile(-defaultextension => '.ps',
-filetypes => [ [ 'PostScript file', '.ps' ],
[ 'All Files', '*' ] ],
-title => 'Print to PostScript',
-initialdir => $initdir);
return unless $fn;
} else {
$fn = '/tmp/svplus.print.'.$$.".ps";
}
my %pspar = (-file => $fn, -colormode => 'gray', -x => $x1,
-y => $y1, -height => $yd+1, -width => $xd+1);
if ($ftype eq 'predefined' and $format eq 'Poster') {
$pspar{-file} = "/tmp/svplus.poster.".$$.".ps";
} else {
if ($ftype eq 'predefined') {
if (defined $format_par{$format}) {
my $xr = $xd / $format_par{$format}{x};
my $yr = $yd / $format_par{$format}{y};
if ($xr > 1 or $yr > 1) {
if ($xr > $yr) {
}
$pspar{-rotate} = $fori;
}
$canvas->postscript(%pspar);
if ($ftype eq 'predefined' and $format eq 'Poster') {
my @p = ();
if ($format_big ne 'Fit') { @p = (-poster => $format_big); }
$poster->posterize(-media => $format_paper, @p, -outfile => $fn, -infile => $pspar{-file});
system "rm -f $pspar{-file}";
}
if ($device eq ':gv') {
exec "$gv $fn ; rm -f $fn" unless fork();
} elsif ($device ne ':ps') {
exec "lpr -P$device $fn ; rm -f $fn" unless fork();
} else {
$main->messageBox(-icon => 'info', -type => 'OK',
-title => 'Print to PostScript file',
-message => 'PostScript file '.$fn.' created.');
}
}
sub canvas_mouse_down {
my ($obj,$x,$y) = @_;
if ($global_bind_cancel) {
$global_bind_cancel = undef;
return;
}
deselect_all();
}
sub exists_name {
my $name = shift;
for (@{$data{tables}}) { return 1 if $_->{name} eq $name; }
for (@{$data{relationships}}) { return 1 if $_->{name} eq $name; }
return 0;
}
sub inc_name {
my $name = shift;
my ($a,$b) = split /_/,$name;
++$b;
return sprintf '%s_%08d',$a,$b;
}
sub new_object {
my $d = $main->DialogBox(-title => 'Type of object',
-buttons => [ 'Create', 'Cancel' ]);
my $type = 'table';
$d->Label(-text => 'Please select type of created object:')
->grid(-column => 1, -row => 1, -sticky => 'ew',
-columnspan => 3);
$d->Radiobutton(-variable => \$type, -value => 'table',
-text => 'Table', -anchor => 'w')
->grid(-column => 2, -row => 2, -sticky => 'ew');
$d->Radiobutton(-variable => \$type, -value => 'view', -text => 'View',
-anchor => 'w')
->grid(-column => 2, -row => 3, -sticky => 'ew');
if (@{$data{tables}}) {
$d->Radiobutton(-variable => \$type, -value => 'relationship',
-text => 'Relationship', -anchor => 'w')
->grid(-column => 2, -row => 4, -sticky => 'ew');
}
$d->gridRowconfigure(1, -weight => 0, -minsize => 30);
$d->gridRowconfigure(2, -weight => 0, -minsize => 30);
$d->gridRowconfigure(3, -weight => 0, -minsize => 30);
$d->gridRowconfigure(4, -weight => 0, -minsize => 30);
$d->gridColumnconfigure(1, -weight => 0, -minsize => 100);
$d->gridColumnconfigure(2, -weight => 0, -minsize => 100);
$d->gridColumnconfigure(3, -weight => 0, -minsize => 100);
if ($d->Show eq 'Create') {
my $d = $main->DialogBox(-title => 'Name of '.$type,
-buttons => [ 'Create', 'Cancel' ]);
my $name = uc $type . '_00000000';
while (exists_name($name)) {
$name = inc_name($name);
if ($name =~ /99999999$/) {
$name = uc $type . '_????????';
last;
}
}
$d->Label(-text => 'Please select name for created '.$type.':')
->grid(-column => 1, -row => 1, -sticky => 'ew');
$d->Entry(-textvariable => \$name)
->grid(-column => 1, -row => 2, -sticky => 'ew');
$d->gridRowconfigure(1, -weight => 0, -minsize => 30);
$d->gridRowconfigure(2, -weight => 0, -minsize => 30);
$d->gridColumnconfigure(1, -weight => 0, -minsize => 100);
$d->gridColumnconfigure(2, -weight => 0, -minsize => 100);
$d->gridColumnconfigure(3, -weight => 0, -minsize => 100);
while ((my $res = $d->Show) ne 'Cancel') {
if ($res eq 'Create') {
unless ($name) {
$main->messageBox(-icon => 'error',
-type => 'OK',
-title => 'Null error',
-message =>
'Name must be filled.');
} elsif (exists_name($name)) {
$main->messageBox(-icon => 'error',
-type => 'OK',
-title => 'Duplicate error',
my @tables = ();
for (sort { $a->{name} cmp $b->{name} } @{$data{tables}}) {
push @tables,$_->{name};
}
my $o1 = $tables[0]; my $o2 = $tables[0];
$d->Optionmenu(-options => \@tables, -textvariable => \$o1)
->grid(-column => 1, -row => 0, -sticky => 'ew');
$d->Optionmenu(-options => \@tables, -textvariable => \$o2)
->grid(-column => 1, -row => 1, -sticky => 'ew');
$d->gridRowconfigure(0, -weight => 1, -minsize => 30);
$d->gridRowconfigure(0, -weight => 1, -minsize => 30);
$d->gridColumnconfigure(0, -weight => 1, -minsize => 100);
$d->gridColumnconfigure(1, -weight => 1, -minsize => 100);
if ($d->Show eq 'Accept') {
$relation{from_table} = $o1;
$relation{to_table} = $o2;
my $ref = \%relation;
push @{$data{relationships}},$ref;
my @rel = @{$data{relationships}};
edit_relationship($rel[$#rel]);
}
}
sub create_table {
my ($name,$type) = @_;
sctypes() unless $data{sc_types};
for (@{$data{sc_types}}) {
if (lc($_->{name}) eq $type) {
$type = $_->{value};
last;
}
}
my %table = ();
$table{name} = $name;
$table{type} = $type;
$table{schema} = 'DESIGN';
$table{columns} = [ ];
push @{$data{tables}},\%table;
edit_table($data{tables}->[scalar(@{$data{tables}})-1]);
}
sub edit_table {
my $table = shift;
my $d = $main->DialogBox(-title => 'Edit '.type_desc($table->{type}),
-buttons => [ 'Accept', 'Cancel' ]);
$d->Label(-text => 'Current structure of '.type_desc($table->{type}).
':')
->grid(-column => 1, -row => 1, -sticky => 'ew',
-columnspan => 3);
my $structure = $d->Scrolled('MListbox', # -setgrid => 1,
-scrollbars => 'e', -selectmode => 'multiple', -sortable => 0,
-columns => [ [ -text => 'Column' ],
[ -text => 'PK', -width => 4 ],
[ -text => 'Indexes', -width => 8 ] ])
->grid(-column => 1, -row => 2, -sticky => 'ew',
-columnspan => 3);
$d->Label(-text => 'Item:')
->grid(-column => 1, -row => 6, -sticky => 'ew');
my $item = '';
my %reserved = (); my %redraw = ();
for my $rel (@{$data{relationships}}) {
if ($rel->{from_table} eq $table->{name}) {
for (@{$rel->{from_columns}}) {
++$reserved{$_->{column}};
}
$redraw{$rel->{name}} = $rel;
}
if ($rel->{to_table} eq $table->{name}) {
for (@{$rel->{to_columns}}) {
++$reserved{$_->{column}};
}
$redraw{$rel->{name}} = $rel;
}
}
$d->Entry(-textvariable => \$item)
->grid(-column => 2, -row => 6, -sticky => 'ew');
$d->Button(-text => 'Add', -command => sub {
return unless $item;
$item = $item;
for ($structure->get(0,'end')) {
if ($_ eq $item) {
$main->messageBox(-icon => 'error',
-type => 'OK',
-title => 'Duplicate error',
-message =>
'Name of item already used.');
return;
}
}
$structure->insert('end',[$item]);
$item = '';
})->grid(-column => 3, -row => 6, -sticky => 'ew');
$structure->delete(0,'end');
my %pk = ();
for (@{$table->{pk}}) { ++$pk{$_}; }
for (@{$table->{columns}}) {
$structure->insert('end',[$_,(exists $pk{$_})?'yes':'']);
}
$d->Button(-text => 'Delete all selected items', -command => sub {
my @sel = $structure->curselection();
my $res = 0;
for (reverse sort @sel) {
if ($reserved{$structure->get($_)}) {
++$res;
} else {
delete $pk{$_} if exists $pk{$_};
$structure->delete($_);
}
}
$main->messageBox(-icon => 'error', -type => 'OK',
-title => 'Check error',
-message => 'You try to delete item which is part of relationship. This operation is not allowed. You must drop relationship before this delete.')
if $res;
})->grid(-column => 1, -row => 4, -sticky => 'ew',
-columnspan => 3);
$d->Button(-text => 'Set selected items as PK', -command => sub {
%pk = ();
for ($structure->curselection()) {
my @it = $structure->get($_);
++$pk{$it[0]->[0]};
}
my @all = map { $_->[0]; } $structure->get(0,'end');
$structure->delete(0,'end');
for (@all) {
$structure->insert('end',
[$_,(exists $pk{$_})?'yes':'']);
}
})->grid(-column => 1, -row => 5, -sticky => 'ew',
-columnspan => 3);
# changing items order
$d->Button(-text => 'Up', -command => sub {
my $first = 0;
for (sort $structure->curselection()) {
if ($_ > $first) {
my @it = $structure->get($_);
$structure->delete($_);
$structure->insert($_-1,$it[0]);
$structure->selectionSet($_-1);
} else {
$first = $_+1;
}
}
})->grid(-column => 1, -row => 3, -sticky => 'w');
$d->Button(-text => 'Down', -command => sub {
my $last = $structure->index('end')-1;
for (reverse sort $structure->curselection()) {
if ($_ < $last) {
my @it = $structure->get($_);
$structure->delete($_);
$structure->insert($_+1,$it[0]);
$structure->selectionSet($_+1);
} else {
$last = $_-1;
}
}
})->grid(-column => 3, -row => 3, -sticky => 'e');
$d->Label(-text => 'Move selected items')
->grid(-column => 2, -row => 3, -sticky => 'ew');
$d->gridRowconfigure(1, -weight => 0, -minsize => 30);
$d->gridRowconfigure(2, -weight => 0, -minsize => 300);
$d->gridRowconfigure(3, -weight => 0, -minsize => 30);
$d->gridRowconfigure(4, -weight => 0, -minsize => 30);
$d->gridRowconfigure(5, -weight => 0, -minsize => 30);
$d->gridRowconfigure(6, -weight => 0, -minsize => 30);
$d->gridColumnconfigure(1, -weight => 0, -minsize => 50);
$d->gridColumnconfigure(2, -weight => 0, -minsize => 150);
$d->gridColumnconfigure(3, -weight => 0, -minsize => 50);
if ($d->Show eq 'Accept') {
$table->{columns} =
[ map { $_->[0]; } $structure->get(0,'end') ];
$table->{pk} = [ keys %pk ];
show_table($table);
for (keys %redraw) { show_relationship($redraw{$_}); }
}
click_repository;
}
sub select_columns {
my $table = shift;
my $d = $main->DialogBox(-title => 'Select columns',
-buttons => [ 'Select', 'Cancel' ]);
$d->Label(-text => 'Select columns from '.$table.':')
->pack(-side => 'top', -anchor => 'center');
my $l = $d->Scrolled('Listbox', -setgrid => 1,
-selectmode => 'multiple', -scrollbars => 'e')
->pack(-side => 'top', -fill => 'both', -expand => 1);
my $tab = undef;
for (@{$data{tables}}) {
if ($_->{name} eq $table) {
$tab = $_;
last;
}
}
return () unless defined $tab;
for (@{$tab->{columns}}) {
$l->insert('end',$_);
}
if ($d->Show() eq 'Select') {
my @all = ();
for ($l->curselection) {
push @all,$l->get($_);
}
return @all;
}
return ();
}
sub edit_relationship {
my $relationship = shift;
my $d = $main->DialogBox(-title => 'Edit '.$relationship->{name}.
' relationship', -buttons => [ 'Accept', 'Cancel' ]);
$d->Label(-text => 'From table: '.$relationship->{from_table})
->grid(-column => 0, -row => 0, -sticky => 'w',
-columnspan => 2);
$d->Label(-text => ' --> ')->grid(-column => 2, -row => 1);
$d->Label(-text => 'To table: '.$relationship->{to_table})
->grid(-column => 3, -row => 0, -sticky => 'w',
-columnspan => 2);
my $lb1 = $d->Scrolled('Listbox', -selectmode => 'multiple',
-setgrid => 1, -scrollbars => 'e')
->grid(-column => 0, -row => 1, -sticky => 'nsew',
-columnspan => 2);
my $lb2 = $d->Scrolled('Listbox', -selectmode => 'multiple',
-setgrid => 1, -scrollbars => 'e')
->grid(-column => 3, -row => 1, -sticky => 'nsew',
-columnspan => 2);
$d->Button(-text => 'Delete', -command => sub {
for (sort $lb1->curselection) {
$lb1->delete($_);
}
})->grid(-column => 0, -row => 2, -sticky => 'nsew');
$d->Button(-text => 'Add', -command => sub {
my %all = ();
for ($lb1->get(0,'end')) {
++$all{$_};
}
for (select_columns($relationship->{from_table})) {
++$all{$_};
}
$lb1->delete(0,'end');
for (sort keys %all) {
$lb1->insert('end',$_);
}
})->grid(-column => 1, -row => 2, -sticky => 'nsew');
$d->Button(-text => 'Delete', -command => sub {
for (sort $lb2->curselection) {
$lb2->delete($_);
}
})->grid(-column => 3, -row => 2, -sticky => 'nsew');
$d->Button(-text => 'Add', -command => sub {
my %all = ();
for ($lb2->get(0,'end')) {
++$all{$_};
}
for (select_columns($relationship->{to_table})) {
++$all{$_};
}
$lb2->delete(0,'end');
for (sort keys %all) {
$lb2->insert('end',$_);
}
})->grid(-column => 4, -row => 2, -sticky => 'nsew');
for (@{$relationship->{from_columns}}) {
$lb1->insert('end',$_->{column});
}
for (@{$relationship->{to_columns}}) {
$lb2->insert('end',$_->{column});
}
$d->gridColumnconfigure(0, -weight => 1, -minsize => 75);
$d->gridColumnconfigure(1, -weight => 1, -minsize => 75);
$d->gridColumnconfigure(2, -weight => 1, -minsize => 50);
$d->gridColumnconfigure(2, -weight => 1, -minsize => 75);
$d->gridColumnconfigure(2, -weight => 1, -minsize => 75);
$d->gridRowconfigure(0, -weight => 1, -minsize => 30);
$d->gridRowconfigure(1, -weight => 1, -minsize => 200);
$d->gridRowconfigure(2, -weight => 1, -minsize => 30);
my $res;
do {
$res = $d->Show;
unless (($lb1->index('end') and $lb2->index('end'))
or $res eq 'Cancel') {
( run in 1.438 second using v1.01-cache-2.11-cpan-df04353d9ac )