#!/usr/bin/perl
#
# $Id: reorg.pl,v 1.3 2005/05/11 05:04:30 mpeppler Exp $

use strict;
use Getopt::Long;
use DBI;
use DBAutil;


#

my $dbname;
my $server;
my $pwd;
my $user      = 'sybadmin';
my $allstats;
my $filename;
my $rebuild;

my $dpcr = $ENV{REORG_DPCR} || 0.95;
my $ipcr = $ENV{REORG_IPCR} || 0.95;
my $sput = $ENV{REORG_SPUT} || 0.75;
my $fwd  = $ENV{REORG_FWD}  || 0.001;

GetOptions('D=s' => \$dbname,   'S=s' => \$server,  'U=s' => \$user,
	   'A'   => \$allstats, 'B'   => \$rebuild, 'P=s' => \$pwd );

die "Usage: $0 -S server -D database [-A] [-B] [-P sa_pwd]"
unless $dbname && $server;

if(!$pwd) {
    $pwd = DBAutil::getPassword($server);
}

die "$0: Sybase user and/or password not set in environment"
    unless $pwd && $user;

my $dbh = DBI->connect("dbi:Sybase:server=$server;database=$dbname",
		       $user, $pwd, { RaiseError => 1 });

my $tabinfo = get_tabinfo($dbh);
run_reorg($dbh, $tabinfo);

exit(0);

sub get_tabinfo {
    my $dbh = shift;

    my $sql = q(
set arithabort off

select s.segment
     , "total_space" = convert(float, sum(u.size)) * @@maxpagesize/(1024.0 * 1024.0)
     , "free_space" = case when s.segment = 2
          then 
            convert(float, sum(lct_admin("logsegment_freepages", db_id()))) * @@maxpagesize / (1024.0 * 1024.0)
          else
            convert(float, sum(curunreservedpgs(u.dbid, u.lstart, u.unreservedpgs))) * @@maxpagesize / (1024.0 * 1024.0)
       end
     , s.name
  into #segments
  from master..sysusages u
     , syssegments s
 where u.dbid = db_id()
   and (power(2, s.segment) & u.segmap) = power(2, s.segment)
 group by s.segment, s.name

select i.id
     , "used" = convert(float, reserved_pgs(i.id, i.doampg)) * @@maxpagesize / (1024.0 * 1024.0)
     , i.segment
  into #used
  from sysobjects o
     , sysindexes i
 where o.id = i.id
   and i.indid < 2
   and o.type = 'U'
   and lockscheme(o.id, db_id()) != 'allpages'

select o.name
     , u.used
     , u.segment
     , 'segname' = s.name
     , s.free_space
--     , "pct" = s.free_space / u.used
     , 'indname' = i.name
     , i.indid
     , 'dpcr' = derived_stat(o.id, i.indid, 'dpcr')
     , 'ipcr' = derived_stat(o.id, i.indid, 'ipcr')
     , 'drcr' = derived_stat(o.id, i.indid, 'drcr')
     , 'lgio' = derived_stat(o.id, i.indid, 'lgio')
     , 'sput' = derived_stat(o.id, i.indid, 'sput') 
     , t.forwrowcnt
     , t.delrowcnt
     , t.rowcnt
  from sysobjects o
     , #used u
     , #segments s
     , sysindexes i
     , systabstats t
 where o.id = u.id
   and u.segment = s.segment
   and i.id = o.id
   and t.id = o.id
   and t.indid = i.indid
 order by u.used, i.indid
);
    my $sth = $dbh->prepare($sql);
    $sth->execute;

    my @tabinfo;
 REDO: {
	while(my $row = $sth->fetchrow_hashref) {
	    push (@tabinfo, {%$row});
	}
	redo REDO if $sth->{syb_more_results};
    }

    return \@tabinfo;
}

sub run_reorg {
    my $dbh     = shift;
    my $tabinfo = shift;

    my %done;

    print STDERR "-- Using the following limits:\n";
    print STDERR "-- Space Usage (sput):                $sput\n";
    print STDERR "-- Data Page Clustering Ratio (dpcr): $dpcr\n";
    print STDERR "-- Indx Page Clustering Ratio (ipcr): $ipcr\n";
    print STDERR "-- Forwarded Row Ratio (fwd)        : $fwd\n";

        foreach my $row (@$tabinfo){
	$row->{fwd} = $row->{forwrowcnt} / $row->{rowcnt} if $row->{rowcnt} > 0;
	$row->{del} = $row->{delrowcnt} / $row->{rowcnt} if $row->{rowcnt} > 0;
	printstat($row) if $allstats;
	
	next if $row->{dpcr} == 1.0 || $row->{ipcr} == 1.0;
	next if $row->{used} < 0.5;    # no point in reorg for very small
                                       # tables
	
	if($row->{indid} < 2) {        # it's the table
	    if(($row->{sput} < $sput && $row->{dpcr} < $dpcr) ||
	        $row->{fwd} > $fwd || $row->{del} > $fwd) {
		printstat($row);
		if(!$rebuild || $row->{pct} < 1.01) {
		    run_command($dbh, qq(print "reorg compact $row->{name}"\nreorg compact $row->{name}));
		} else{
		    run_command($dbh, qq(print "reorg rebuild $row->{name}"\nreorg rebuild $row->{name}));
		    $done{$row->{name}} = 1;
		}
	    }
	} else {                       # it's an index
	    if(!$done{$row->{name}}) {
		if($row->{sput} < $sput && $row->{ipcr} < $ipcr) {
		    printstat($row);
		    run_command($dbh, qq(print "reorg rebuild $row->{name} $row->{indname}"\nreorg rebuild $row->{name} $row->{indname}));
		}
	    }
	}
    }

}

sub printstat {
    my $row = shift;
    my @derived_cols = qw(dpcr ipcr drcr lgio sput fwd del used); 

    my $dfmt = " %-7s" x @derived_cols;
    printf STDERR "-- %-15s %5s$dfmt\n", 'name', 'indid', @derived_cols;
    $dfmt =~ s/-7s/7.5f/g;
    unshift(@derived_cols, 'name', 'indid');
    printf STDERR "-- %-15.15s %5d$dfmt\n", @{$row}{@derived_cols};
}

sub run_command {
    my $dbh = shift;
    my $sql = shift;

    my $sth = $dbh->prepare($sql);
    $sth->execute;
    REDO: {
	    while(my $row = $sth->fetch) {
		print "@$row\n";
	    }
	    redo REDO if $sth->{syb_more_results};
	}

    my $sec = 60;

    print STDERR "Sleeping for $sec seconds\n";
    sleep($sec);
}