view release on metacpan or  search on metacpan

Tk/Application/Stadaf.pm  view on Meta::CPAN

  
  my $DIALOG = $self->{TW}->DialogBox(
				      -title          => 'Options',
				      -buttons        => ['Ok', 'Cancel'],
				     );
  
  my $root = $DIALOG->Frame()->pack(-fill=>'both',-expand=>1 );
  
  # widget creation 
  
  my($label_2) = $root->Label (
			       -font => '-*-MS Sans Serif-Bold-R-Normal-*-*-200-*-*-*-*-*-*',
			       -text => 'Dumping options',
			      );
  my($label_1) = $root->Label (
			       -text => 'Field separator:',
			      );
  my($entry_1) = $root->Optionmenu(
				   -options => [('none', 'TAB', q!:!, q!,!, q!;!)],
				   -textvariable => \$fs,
				   -font => $self->{FIXFONT},
				  );
  my($label_3) = $root->Label (
			       -text => 'Line separator:',
			      );
  my($button_1) = $root->Optionmenu(
				    -options => [qw/none CRLF LF/],
				    -textvariable => \$rs,
				    -font => $self->{FIXFONT},
				   );
  my($label_4) = $root->Label (
			       -text => 'Quote string char:',
			      );
  my($entry_2) = $root->Optionmenu(
				   -options => [('none', q!"!, q!'!)], #"
				   -textvariable => \$qs,
				   -font => $self->{FIXFONT},
				  );
  
  my($label_5) = $root->Label (
			       -text => 'Struct separator:',
			      );
  my($entry_3) = $root->Optionmenu(
				   -options => [('none', '|', 'SPC', 'TAB', ',', ';', ':', '-', '+')],
				   -textvariable => \$ss,
				   -font => $self->{FIXFONT},
				  );
  
  my($checkbutton_1) = $root->Checkbutton (
					   -text => 'include headers',
					   -variable => \$headers,
					  );
  
  
  # Geometry management
  
  $label_2->grid(
		 -in => $root,
		 -column => '1',
		 -row => '1',
		 -columnspan => '2'
		);
  
  $label_1->grid(
		 -in => $root,
		 -column => '1',
		 -row => '2',
		 -sticky => 'e'
		);
  
  $entry_1->grid(
		 -in => $root,
		 -column => '2',
		 -row => '2'
		);
  
  $label_3->grid(
		 -in => $root,
		 -column => '1',
		 -row => '3',
		 -sticky => 'e'
		);
  
  $button_1->grid(
		  -in => $root,
		  -column => '2',
		  -row => '3'
		 );
  
  $label_4->grid(
		 -in => $root,
		 -column => '1',
		 -row => '4',
		 -sticky => 'e'
		);
  
  $entry_2->grid(
		 -in => $root,
		 -column => '2',
		 -row => '4'
		);
  
  $label_5->grid(
		 -in => $root,
		 -column => '1',
		 -row => '5',
		 -sticky => 'e'
		);
  
  $entry_3->grid(
		 -in => $root,
		 -column => '2',
		 -row => '5'
		);
  
  $checkbutton_1->grid(
		       -in => $root,
		       -column => '1',
		       -row => '6',
		       -columnspan => '2'
		      );
  
  # Resize behavior management
  
  # container $root (rows)
  $root->gridRowconfigure(1, -weight  => 0, -minsize  => 30);
  $root->gridRowconfigure(2, -weight  => 0, -minsize  => 30);
  $root->gridRowconfigure(3, -weight  => 0, -minsize  => 30);
  $root->gridRowconfigure(4, -weight  => 0, -minsize  => 30);
  $root->gridRowconfigure(5, -weight  => 0, -minsize  => 30);
  $root->gridRowconfigure(6, -weight  => 0, -minsize  => 30);
  
  # container $root (columns)
  $root->gridColumnconfigure(1, -weight => 0, -minsize => 30);
  $root->gridColumnconfigure(2, -weight => 0, -minsize => 2);
  
  # additional interface code
  # end additional interface code
  
  my $rc = $DIALOG->Show;
  $self->ClearMsg;
  return unless ($rc=~/ok/i);
  
  $self->{OPTS}->{rs} = $rs;
  $self->{OPTS}->{rs} = ''     if ($rs eq 'none');
  $self->{OPTS}->{rs} = "\n"   if ($rs eq 'LF');
  $self->{OPTS}->{rs} = "\r\n" if ($rs eq 'CRLF');
  
  $self->{OPTS}->{fs} = $fs;
  $self->{OPTS}->{fs} = ''     if ($fs eq 'none');
  $self->{OPTS}->{fs} = "\t"   if ($fs eq 'TAB');
  
  $self->{OPTS}->{ss} = $ss;
  $self->{OPTS}->{ss} = ''     if ($ss eq 'none');
  $self->{OPTS}->{ss} = "\t"   if ($ss eq 'TAB');
  $self->{OPTS}->{ss} = ' '    if ($ss eq 'SPC');
  
  $self->{OPTS}->{qs} = $qs;
  $self->{OPTS}->{qs} = ''     if ($qs eq 'none');
  
  $self->{OPTS}->{headers} = $headers;
  $self->{OPTS}->{ignorememo}   = $memos;
  
}

#######################################################
sub Open_FH {
  my $self = shift;
  
  my $DB   = $self->{DB} || return;
  $self->{MAX} = -1;
  
  my $file = $self->{FILE} || '';
  
  $file =~ s/\\/\//g;
  $file =~ s/\/[^\/]*$//;
  $file =~ s/\//\\/g if($^O =~ /win/i);
  
  undef $file unless $file;