PEPPLER.ORG
Michael Peppler
Sybase Consulting
Menu
Home
Sybase on Linux
Install Guide for Sybase on Linux
General Sybase Resources
General Perl Resources
Freeware
Sybperl
Sybase::Simple
DBD::Sybase
BCP Tool
Bug Tracker
Mailing List Archive
Downloads Directory
FAQs
Sybase on Linux FAQ
Sybperl FAQ
Personal
Michael Peppler's resume

sybperl-l Archive

Up    Prev    Next    

From: "Sabherwal, Balvinder K dot " <BKSabherwal at lmus dot leggmason dot com>
Subject: Fork error in Perl.
Date: Feb 9 2001 1:24PM

> I am getting the following error in one of my perl scripts when I try for
> do a fork. This is an AIX machine 4.3 version. This script use to run fine
> on an HP unix m/c.
> 
> Can anyone help me with this.
> 
> ######################## Forked, but do not know to change a TTY.
> ################
>   Define $DB::fork_TTY
>           -  or a function DB::get_fork_TTY() which will set
> $DB::fork_TTY.
> The value of $DB::fork_TTY should be the name of TTY to use.
> On UNIX-like systems one can get the name of a TTY for the given window 
> by typing tty, and disconnect the shell from TTY by sleep 1000000.
> 
> 
> the script code is as below.
> 
> Thanks in advance.
> ****************************************************************
> ****    PERL SCRIPT CODE
> ****************************************************************
> 
> #!/usr/local/bin/perl
> 
> ## Initializations 
> use Getopt::Std;
> use POSIX;
> use Sybase::CTlib;
> 
> if (!getopts('S:D:T:AF:sP:I:CvhH')) {
>      print "$USAGE\n";
>      exit 1;
> }
> $parpid=getppid();
> $ts=`date +%y-%h-%d:%H-%M-%S`;
> $server = $opt_S;
> 
>    sub get_sa_password ()
>    {
>       $password = `/dbadmin/getsap $server`;
>       chomp ($password);
>    }
> 
> 
> get_sa_password();
> 
> $opt_count=0;         # to take care of only one option should be
> specified 
>                       # from {-T | -s | -A|-F FileName} 
> $updateType="PARTIAL"; # FULL(against all the tables) or PARTIAL.
> $Srv=$opt_S;
> $LogicalDBName=$opt_D;
> $usr="sa";
> $pswd=$password;
> 
> ##  if none of the options are specified 
> if(!$opt_S && !$opt_D && !$opt_T && !$opt_A && !$opt_F && !$opt_C &&
> !$opt_s && !$opt_I && !$opt_v && !$opt_P && !$opt_h && !$opt_H) {
>    die "$USAGE";
> }
> die "$USAGE" if $opt_H;
> die "$USAGE" if $opt_h;
> 
> if($Srv eq undef){
>    die "***Error(1200):Server name required***\n$USAGE";
> }
> 
> ##$intr="D";
> 
> if($opt_I){
>    $intr=$opt_I;
> } # end of if ($opt_I)
> 
> if(($opt_s) && !($opt_I))
> {
>     die "***Error(1200):Interval required for automated run ***\n$USAGE";
> }
> 
> if(!($LogicalDBName)){
>    die "***Error($Srv, 1201):Database name required ***\n $USAGE";
> } 
> 
> if(!($usr)){
>    die "***Error($Srv, 1201):Login User Name required ***\n $USAGE";
> }
> if(!($password)){
>    die "***Error($Srv, 1201): Can't get the password!!! Password is
> required ***\n";
> }
> if ($opt_s){
>    $opt_count++;
> } # end of if ($opt_s)
> 
> if ($opt_A && $opt_I) {
>     die "***Error($Srv, 1201):Interval not needed with all tables. ***\n
> $USAGE";
> }
> 
> if ($opt_F && $opt_I) {
>     die "***Error($Srv, 1201):Interval not needed with file list.  ***\n
> $USAGE";
> }
> 
> if ($opt_F){
>    $TableListFile=$opt_F; $opt_count++;
>    if(!-e "$TableListFile"){
>        die "*** Error($Srv, 1203) File '$TableListFile' doesn't exist
> ***\n " .
>            "$USAGE";
>    }
> } # end of if ($opt_F)
> 
> #
> # All tables in the database
> #
> if ($opt_A){
>    $AllTables=1; $opt_count++; $updateType="FULL";
> } 
> 
> if ($opt_T){
>    $TableName=$opt_T; $opt_count++;
> } # end of if ($opt_T)
> 
> $Recompile=1 if $opt_C; #  $Recompile recompile option
> $pwd=$opt_p;
> $Verbose=1 if $opt_v;
> 
> if ($opt_P) {
>     $PDeg=$opt_P;
> }
> else {
>     $PDeg=3; ##Default Parallel degree.
> }
> 
> #
> # More than one option not allowed in {-A|-T ...|-F ...}
> #
> if($opt_count > 1){ 
>    die "*** Error(1204):Only one of these options required \n".
>        "-T Table_Name | -A | -F tbl-list-file ***\n$USAGE";
> }
> 
> #
> # Atleast one option required in{-A|-T ...|-F ...}
> #
> if($opt_count == 0){ 
>    die "*** Error(1205):Atleast one of these options required \n".
>        "-A |-F tbl-list-file ***\n$USAGE";
> }
> 
> if ($opt_C) {
>    $JOB_NAME = "Update Statistics and Recompile";
>    $recompile='R';
> }
> else {
>    $JOB_NAME = "Update Statistics";
> }
> 
> ## Global count for number of update stats/sp_recompiles failures.
> $count=0;
> $childctr=0;
> 
> 
> #### Initialize the log handle
> 
> open(fh,">> update_stats.$server.$LogicalDBName.$ts");
> 
> %LogHeader = ('Database '    , $LogicalDBName,
> 	      'Server   '    , $server,
>               'JobName  '    , $JOB_NAME,
>               'File     '    , $TableListFile,
>               'AllTable '    , $AllTables,
>               'Verbose  '    , $Verbose,
> 	      'Table    '    , $opt_T,
>               'Interval '    , $opt_I,
>               'Recompile'    , $opt_C,
>               'User     '    , $usr,
>               'Parallel '    , $PDeg);
> 
> $line= "=" x 80;
> 
> print fh $line . "\n";
> 
> foreach $key (keys (%LogHeader)) {
>      $value = $LogHeader{$key};
>      print fh "\t\t$key \t\t=\t\t $value \n";
>      }
> 
> print fh $line . "\n";
> 
>     
>    $uid = 'sa'; $pwd = $password; $srv = $server;
> 
> $tbcnt=0;
> $t=0;
> $chdctr=0;
> 
> 
> ## Get the table names from table list file.
> if ($opt_F)
> {
>     print fh "Generating table list from file $TableListFile \n";
>     $tbcnt=0;
>     $t=0;
>     $TableListRef=getTableList();
>     $tbcnt=scalar(@$TableListRef);
>     print fh "Found $tbcnt tables to process \n";
>     print fh "changing the database to $LogicalDBName \n";
> #    $dbhndl->ct_sql("use $LogicalDBName");
>     
>     foreach $tb (@$TableListRef) 
>     {
>         if($t+1 == scalar(@$TableListRef))
>         {
>            $done = "T";
>         }
>         if  ($chdctr < $PDeg)
>         {
> 	  ##$rc=startchild();
>           $chdctr++;
> 	   if( $chd=fork) ****************** THIS IS THE LINE ON WHICH IT
> GIVES THE ERROR. **************************
>            {
>               open($tb,"> $tb");
>               push(@childlist,$chd);
>               $chndl=Sybase::CTlib->ct_connect($usr, $pswd, $Srv); 
>               print $tb "\n\n Processing table $tb \n";
>               $ts=`date +%y-%h-%d:%H-%M-%S`;
>               print $tb "Started update stats for table $tb at $ts \n";
>               $chndl->ct_sql("use $LogicalDBName");
>               $chndl->ct_sql("update statistics $tb");
>               ct_callback(CS_SERVERMSG_CB, "srv_cb");
>               ct_callback(CS_CLIENTMSG_CB, \&msg_cb);
>               if(($recompile eq "R"))
>               {
>                   print $tb "starting recompile for $tb \n";
>                   $chndl->ct_sql("exec sp_recompile $tb");
>                   ct_callback(CS_SERVERMSG_CB, "srv_cb");
>                   ct_callback(CS_CLIENTMSG_CB, \&msg_cb);
>               }
>               $ts=`date +%y-%h-%d:%H-%M-%S`;
>               print $tb "Command completed, check for the errors.... $ts
> \n";
>               $chndl->ct_sql("exit");
>               close($tb);
>               # print "the child is $child\n";
>               #print "the child count is ", $child_counter++,"\n";
>               ##return $child;
>            }
>            elsif($chd==0)
>            {
>               use POSIX qw(setsid);
>               $curpid=setsid()          or die "Can't start a new
> session";
>               push(@childlist,$curpid);
>               $chndl=Sybase::CTlib->ct_connect($usr, $pswd, $Srv); 
>               open($tb,"> $tb");
>               print $tb "\n\n Processing table $tb \n";
>               $ts=`date +%y-%h-%d:%H-%M-%S`;
>               print $tb "Started update stats for table $tb at $ts \n";
>               $chndl->ct_sql("use $LogicalDBName");
>               $chndl->ct_sql("update statistics $tb");
>               ct_callback(CS_SERVERMSG_CB, "srv_cb");
>               ct_callback(CS_CLIENTMSG_CB, \&msg_cb);
>               if(($recompile eq "R"))
>               {
>                   print $tb "starting recompile for $tb \n";
>                   $chndl->ct_sql("exec sp_recompile $tb");
>                   ct_callback(CS_SERVERMSG_CB, "srv_cb");
>                   ct_callback(CS_CLIENTMSG_CB, \&msg_cb);
>               }
>               $ts=`date +%y-%h-%d:%H-%M-%S`;
>               print $tb "Command completed, check for the errors.... $ts
> \n";
>               $chndl->ct_sql("exit");
>               close($tb);
>               # print "the child is $child\n";
>               #print "the child count is ", $child_counter++,"\n";
>               ##return $child;
>            } 
>            else
>            {
>               print $tb "Can't fork child....";
>            }
>               next;
> 
>        }
>        else {
>           foreach $chd (@childlist) {
>           waitpid ($rcp, 0);
>           }
>        }
>        while ($chdctr == $PDeg)
>        { 
> 
>           if($pid)
>           {
>              kill('kill',$pid);
>              $chdctr--;
>              $t++; next;
>           }
>           else {
> 	      $SIG{CHLD} = sub{ wait };
>           }
>         }
>     }
>    
>      if(($done) ne "T")
>      {
>          print fh "Nothing to do..... No data returned from the
> server...Exiting !!!!! \n";
>          print fh $line . "\n";
>          print fh "End of Results Sets \n";
>          close(fh);
>          exit 0;
>      }
>      else
>      {
>          print fh "Nothing more to do...Completed the job...Exitting !!!!!
> \n";
>          print fh $line . "\n";
>          print fh "End of Results Sets\n";
>          close(fh);
>          exit 0;
>       }
> }
> 
> 
> #############################################
> ##  SUBROUTINES
     #############################################

> sub msg_cb
>     {
>         my($layer, $origin, $severity, $number, $msg, $osmsg, $dbh) = @_;
> 
>         printf $tb "\nOpen Client Message: (In msg_cb)\n";
>         printf $tb "Message number: LAYER = (%ld) ORIGIN = (%ld) ",
>                $layer, $origin;
>         printf $tb "SEVERITY = (%ld) NUMBER = (%ld)\n",
>                $severity, $number;
>         printf $tb "Message String: %s\n", $msg;
>         if (defined($osmsg))
>         {
>             printf $tb "Operating System Error: %s\n", $osmsg;
>         }
>         CS_SUCCEED;
>     }
> 
>     sub srv_cb 
>    {
>         my($dbh, $number, $severity, $state, $line, $server,
>            $proc, $msg) = @_;
> 
> 
>     # If $dbh is defined, then you can set or check attributes
>     # in the callback, which can be tested in the main body
>     # of the code.
> 
> 	printf $tb "\nServer message: (In srv_cb)\n";
>         printf $tb "Message number: %ld, Severity %ld, ",
>                $number, $severity;
>         printf $tb "State %ld, Line %ld\n", $state, $line;
> 
> 
>         if (defined($server)) 
>         {
>             printf $tb "Server '%s'\n", $server;
>         }
> 
> 
>         if (defined($proc)) 
>         {
>             printf $tb " Procedure '%s'\n", $proc;
>         }
> 
> 
>         printf $tb "Message String: %s\n", $msg;  CS_SUCCEED;
>    }
> 
> close(fh);
>    #
>    # Get the sorted table list  by size
>    #
> 
> # 
> # Gets the sorted tablelist 
> # This module uses the global options($DefaultFile, $TableListFile)
> # ErrorCodes 1300-1319
> sub getTableList{
>       my $Row;
>       my @TableList;
> 
>       #
>       # -F option, to get the tables from the user given file,
>       #
>       if($TableListFile){
>          if(!open(READLIST, "$TableListFile")){
>             print fh "getTableList ".  "unable to open the specified file
> ".  "' $TableListFile' \n";
>             exit(1);
>          }
>          print fh "$TableListFile used as the tablelist \n";
>          while(){
>               chomp;
>               $_ =~ / *(\w+) */;# match just the word(here table name)
>                                 # without spaces before or after.
>               push @TableList, $1; 
>          }
>          close(READLIST);
> 
> 
> 
>       }# end of elsif($TableListFile)
>       #
>       # Returning the table list
>       #
>       return \@TableList;  
> 
> } ## end of sub gettablelist
> 
> 
IMPORTANT:  The security of electronic mail  sent through the Internet 
is not guaranteed.  Legg Mason therefore recommends that you do not 
send confidential information to us via electronic mail, including social 
security numbers, account numbers, and personal identification numbers.    

Delivery, and timely delivery, of electronic mail is also not 
guaranteed.  Legg Mason therefore recommends that you do not send time-sensitive 
or action-oriented messages to us via electronic mail, including 
authorization to  "buy" or "sell" a security or instructions to conduct any 
other financial transaction.  Such requests, orders or instructions will 
not be processed until Legg Mason can confirm your instructions or 
obtain appropriate written documentation where necessary.