view release on metacpan or  search on metacpan

lib/DBI/Shell.pm  view on Meta::CPAN

}

sub load_plugins {
	my ($sh, @ppi) = @_;
	# Output must  not  appear  while  loading  plugins:
	# It  might  happen,  that  batch  mode  is  entered
	# later!
	my @pi;
	return unless(@ppi);
	foreach my $n (0 .. $#ppi) {
		next unless ($ppi[$n]);
		my $pi = $ppi[$n];

		if ( ref $pi eq  'HASH' ) {
			# As we descend down the hash reference,
			# we're looking for an array of modules to source in.
			my @mpi = keys %$pi;
			foreach my $opt (@mpi) {
				#print "Working with $opt\n";
				if ($opt =~ /^option/i) {
					# Call the option handling.
					$sh->install_options( @{$pi->{$opt}} );
					next;
				} elsif ( $opt =~ /^database/i ) {
					# Handle plugs for a named # type of database.
					next unless $sh->{dbh};
					# Determine what type of database connection.
					my $db = $sh->{dbh}->{Driver}->{Name};
					$sh->load_plugins( $pi->{$opt}->{$db} )
						if (exists $pi->{$opt}->{$db});
					next;
				} elsif ( $opt =~ /^non-database/i ) {
					$sh->load_plugins( $pi->{$opt} );
				} else  {
					$sh->load_plugins( $pi->{$opt} );
				}
			}
		} elsif ( ref $pi eq 'ARRAY' ) {
			@pi = @$pi;
		} else {
			next unless $pi;
			push(@pi, $pi);
		}
		foreach my $pi (@pi) {
			my $mod = $pi;
			$mod =~ s/\.pm$//;
			#print "Module: $mod\n";
			unshift @DBI::Shell::Std::ISA, $mod;
			eval qq{ use $pi };
			if ($@) {
				warn "Failed: $@";
				shift @DBI::Shell::Std::ISA;
				shift @pi;
			} else {
				$sh->print_buffer_nop("Loaded plugins $mod\n")
					unless $sh->{batch};
			}
		}
	}
	local ($|) = 1;
    # plug-ins should remove options they recognise from (localized) @ARGV
    # by calling Getopt::Long::GetOptions (which is already in pass_through mode).
    foreach my $pi (@pi) {
	local *ARGV = $sh->{unhandled_options};
		$pi->init($sh);
    }
	return @pi;
}

sub default_config {
	my $sh = shift;
    #
    # Set default configuration options
    #
    foreach my $opt_ref (
	 [ 'command_prefix_line=s'	=> '/' ],
	 [ 'command_prefix_end=s'	=> ';' ],
	 [ 'command_prefix=s'	=> '[/;]' ],
	 [ 'chistory_size=i'	=> 50 ],
	 [ 'rhistory_size=i'	=> 50 ],
	 [ 'rhistory_head=i'	=>  5 ],
	 [ 'rhistory_tail=i'	=>  5 ],
	 [ 'user_level=i'		=>  1 ],
	 [ 'editor|ed=s'		=> ($ENV{VISUAL} || $ENV{EDITOR} || 'vi') ],
	 [ 'batch'				=> 0 ],
	 [ 'format=s'				=> 'neat' ],
	 [ 'prompt=s'			=> undef ],
	# defaults for each new database connect:
	 [ 'init_trace|trace=i' => 0 ],
	 [ 'init_autocommit|autocommit=i' => 1 ],
	 [ 'debug|d=i'			=> ($ENV{DBISH_DEBUG} || 0) ],
	 [ 'seperator|sep=s'	=> ',' ],
	 [ 'sqlpath|sql=s'		=> '.' ],
	 [ 'tmp_dir|tmp_d=s'	=> $ENV{DBISH_TMP} ],
	 [ 'tmp_file|tmp_f=s'	=> qq{dbish$$.sql} ],
	 [ 'home_dir|home_d=s'	=> $ENV{HOME} || "$ENV{HOMEDRIVE}$ENV{HOMEPATH}" ],
	 [ 'desc_show_remarks|show_remarks' => 1 ],
	 [ 'desc_show_long|show_long' => 1 ],
	 [ 'desc_format=s'		=> q{partbox} ],
	 [ 'desc_show_columns=s' => q{COLUMN_NAME,DATA_TYPE,TYPE_NAME,COLUMN_SIZE,PK,NULLABLE,COLUMN_DEF,IS_NULLABLE,REMARKS} ],
	 [ 'null_format=s'		=> '(NULL)' ],
	 [ 'bool_format=s'		=> q{Y,N} ],
	 @_,
    ) {
	$sh->add_option(@$opt_ref);
    }

}
    

sub default_commands {
	my $sh = shift;
    #
    # Install default commands
    #
    # The sub is passed a reference to the shell and the @ARGV-style
    # args it was invoked with.
    #
    $sh->{commands} = {
    'help' => {
	    hint => "display this list of commands",

lib/DBI/Shell.pm  view on Meta::CPAN

    'option' => {
	    hint => "display or set an option value",
    },
    'describe' => {
	    hint => "display information about a table (columns, data types).",
    },
    'load' => {
	    hint => "load a file from disk to the current buffer.",
    },
    'run' => {
	    hint => "load a file from disk to current buffer, then executes.",
    },
    'save' => {
	    hint => "save the current buffer to a disk file.",
    },
    'spool' => {
	    hint => "send all output to a disk file. usage: spool file name or spool off.",
    },

    };

}

sub default_term {
	my ($sh, $class) = @_;
    #
    # Setup Term
    #
    my $mode;
    if (!is_interactive()) {
		$sh->{batch} = 1;
		$mode = "in batch mode";
    } else {
		$sh->{term} = new Term::ReadLine($class);
		if ($sh->{term}->Features->{readHistory}) {
			$sh->{term}->ReadHistory(File::Spec->catfile(File::HomeDir->my_home, HISTORY_FILE));
		}
		$mode = "";
    }

	return( $mode );
}

sub new {
    my ($class, @args) = @_;

    my $sh = bless {}, $class;
    
	$sh->default_config;
	$sh->default_commands;

    #
    # Handle command line parameters
    #
    # data_source and user command line parameters overrides both 
    # environment and config settings.
    #

	$DB::single = 1;

    local (@ARGV) = @args;
    my @options = values %{ $sh->{options} };
    Getopt::Long::config('pass_through');	# for plug-ins
    unless (GetOptions($sh, 'help|h', @options)) {
		$class->usage;
		croak "DBI::Shell aborted.\n";
    }
    if ($sh->{help}) {
		$class->usage;
		return;
    }

    $sh->{unhandled_options} = [];
    @args = ();
    foreach my $arg (@ARGV) {
		if ($arg =~ /^-/) {	# expected to be in "--opt=value" format
			push @{$sh->{unhandled_options}}, $arg;
		}
		else {
			push @args, $arg;
		}
    }

	# This may be obsolete since it is run again in DBI::Shell::new.
    $sh->do_format($sh->{format});

    $sh->{data_source}  = shift(@args) || $ENV{DBI_DSN}  || '';

    my $user            = shift(@args);
    $sh->{user}         = defined $user     ? $user     : $ENV{DBI_USER} || '';
    my $password        = shift(@args);
    $sh->{password}     = defined $password ? $password : $ENV{DBI_PASS} || undef;

    $sh->{chistory} = [];	# command history
    $sh->{rhistory} = [];	# result  history
	$sh->{prompt}   = $sh->{data_source};

# set the default io handle.
	$sh->{out_fh}		= \*STDOUT;

# support for spool command ...
	$sh->{spooling} = 0; $sh->{spool_file} = undef; $sh->{spool_fh} = undef;

	my $mode = $sh->default_term($class);

    $sh->log("DBI::Shell $DBI::Shell::VERSION using DBI $DBI::VERSION $mode");
    $sh->log("DBI::Shell loaded from $INC{'DBI/Shell.pm'}") if $sh->{debug};

    return $sh;
}

# Used to install, configure, or change an option or command.
sub install_options {
	my ($sh, $options) = @_;

	my @po;
	$sh->log( "reference type: " . ref $options )
		if $sh->{debug};

	if ( ref $options eq 'ARRAY' ) {