view release on metacpan or  search on metacpan

lib/Genezzo/GenDBI.pm  view on Meta::CPAN

        {
            $showhelp = 1;
        }
        else
        {
            $showhelp = 1;
            $msg = "invalid SHOW argument ($argval)\n";
            $severity = 'warn';
        }
    }
    if ($showhelp)
    {
        $msg .= "\nlegal values are:\n";
        while ( my ($kk, $vv) = each (%legitdefs))
        {
            $msg .= "  show $kk - $vv\n";
        }          
        my %earg = (self => $self, msg => $msg,
                    severity => $severity);
                    
        &$GZERR(%earg)
            if (defined($GZERR));
    }

    return 1;
}

sub Kgnz_Startup
{
    my $self = shift;
    my $dictobj = $self->{dictobj};
    my %args = (
		@_);

    greet @_ ; 
    $args{dbh_ctx} = $self->{dbh_ctx};
    return $dictobj->DictStartup(@_);
}

sub Kgnz_Shutdown
{
    my $self = shift;
    my $dictobj = $self->{dictobj};
    my %args = (
		@_);

    greet @_ ; 
    $args{dbh_ctx} = $self->{dbh_ctx};
    return $dictobj->DictShutdown(@_);
}

sub Kgnz_Password
{
    my $self = shift;
    my $dictobj = $self->{dictobj};
    my %args = (
		@_);

    greet @_ ; 

    my ($uname, $cryptpwd) = (getpwuid($<))[0,1];
    my $plainword;

    # XXX XXX : looks like this getpwuid returns the crypt from the
    # shadow file - an 'x'

# XXX XXX : need term::readkey    

    system "stty -echo";
    print "Password: ";
    chomp($plainword = <STDIN>);
    print "\n";
    system "stty echo";
    
    if (crypt($plainword, $cryptpwd) ne $cryptpwd) {
        print "sorry!\n";
    } else {
        print "ok\n";
    }


    return 1;
}

sub Feeble_Delete
{
    my $self = shift;

    my @outi = ($FEEBLE_DOWNCASE) ? map(lc, @_) : @_;

    if ($FEEBLE_DOWNCASE && scalar(@outi))
    {
        my $tablename = $outi[0];

        unless (Feeble_tablename_check($tablename))
        {
            my $msg = "invalid indentifier $tablename\n";
            my %earg = (self => $self, msg => $msg,
                        severity => 'warn');
            
            &$GZERR(%earg)
                if (defined($GZERR));
            return 0;
        }
    }

    return $self->Kgnz_Delete(@outi);

}

sub Kgnz_Delete
{
#    greet @_ ; 
    my $self = shift;
    my $dictobj = $self->{dictobj};
  L_ParseDelete:
    {
	last if (@_ < 2);

	my $tablename = shift @_ ;
	my @params = @_ ;
#        greet @params;

        my ($msg, %earg);