Re: new to perl

[Chuck Fox]

Shirley,

I do almost the exact same thing in my database dump script.  Here is 
the function that I use to remove older dump files.

HTH,

Chuck Fox

<code>
################################################################
###  Prune Dumps Subroutine
###
###  Description:
###     This subroutine will remove all dumps that are older
###     than the 48 hour aging period.
###
###  Input Parameters: $ppdDumpDir   = command run,
###                    $ppdDbName    = message number,
###                    $ppdRetDate   = message severity,
###                    $ppdDumpType  = message state,
###
###  Output Parameters: $ppdError
###
################################################################
sub pruneDumps
{
       my(
               $ppdDumpDir
               ,$ppdDbName
               ,$ppdRetDate
               ,$ppdDumpType
       ) = @_;
       my(
               $ppdDumpFile
               ,$ppdError
               ,$ppdSaveError
               ,$ppdCmd
               ,$ppdLocalDumpType
               ,$ppdTmpTime1
               ,$ppdTmpTime2
               ,@ppdDumps
       );
       my( $myMsg );
       if( defined( $CONFIG{gDebugFlag} ) )
       {
               $myMsg = sprintf(":   pruneDumps(%s: Entering 
subroutine.)\n",__LINE__);
               &logIt( $myMsg );
       }

       if( defined( $CONFIG{gNoExecFlag} ) )
       {
               if (defined($CONFIG{gDebugFlag}))
               {
                       $myMsg = sprintf(":   pruneDumps(%s: Running in 
noexec mode.)\n",__LINE__);
                       &logIt( $myMsg );
                       print "\$ppdDumpDir=$ppdDumpDir\n";
                       print "\$ppdDbName=$ppdDbName\n";
                       print "\$ppdRetDate=$ppdRetDate\n";
                       print "\$ppdDumpType=$ppdDumpType\n";
               }
       }

       $myMsg = sprintf(":   pruneDumps(%s: Getting dump file 
list.)\n",__LINE__);
       &logIt( $myMsg );

       opendir DUMPDIR,$ppdDumpDir;
       @ppdDumps = readdir DUMPDIR;
       closedir DUMPDIR;
       $ppdError = 0;
       if($ppdDumpType eq "database")
       {
               $ppdLocalDumpType = "_dump";
       }
       elsif( $ppdDumpType eq "tran" )
       {
               $ppdLocalDumpType = "_tran";
       }
       foreach $ppdDumpFile ( @ppdDumps )
       {
               if ( $ppdDumpFile =~ /${ppdDbName}${ppdLocalDumpType}/ )
               {
                       open(RFILE,"${ppdDumpDir}/${ppdDumpFile}");
                       (
                               $ppdDev
                               ,$ppdIno
                               ,$ppdMode
                               ,$ppdNlink
                               ,$ppdUid
                               ,$ppdGid
                               ,$ppdRdev
                               ,$ppdSize
                               ,$ppdAtime
                               ,$ppdMtime
                               ,$ppdCtime
                               ,$ppdBlksize
                               ,$ppdBlocks
                       ) = stat RFILE;
                       close(RFILE);
                       if( defined( $CONFIG{gNoExecFlag} ) )
                       {
                               if( defined( $CONFIG{gDebugFlag} ) )
                               {
                                       $ppdTmpTime1 = localtime($ppdAtime);
                                       $ppdTmpTime2 = 
localtime($ppdRetDate);
                                       print "\$ppdDumpFile = 
$ppdDumpFile\n\t\$ppdRetDate = $ppdTmpTime2\n\t\$ppdAtime = $ppdTmpTime1\n";
                               }
                       }

                       if( $ppdAtime < $ppdRetDate )
                       {
                               $myMsg = sprintf(":   pruneDumps(%s: 
Deleting dump file %s.)\n",__LINE__,$ppdDumpFile);
                               &logIt( $myMsg );

                               $ppdError = system( "rm -f 
${ppdDumpDir}/${ppdDumpFile}" );

                               if ( $ppdError != 0  && $ppdError != 256 )
                               {
                                       $myMsg = sprintf(":   
pruneDumps(%s: ERROR[%s] Deleting dump file 
%s.)\n",__LINE__,$ppdError,$ppdDumpFile);
                                       &logIt( $myMsg );
                                       $ppdSaveError = $ppdError;
                               }
                       }
                       else
                       {
                               if( defined( $CONFIG{gDebugFlag} ) )
                               {
                                       $myMsg = sprintf(":   
pruneDumps(%s: Not deleting dump file %s.)\n",__LINE__,$ppdDumpFile);
                                       &logIt( $myMsg );
                               }
                       }
               }
       }
       return( $ppdSaveError );
}

</code>

[EMAIL PROTECTED] wrote:

Hi,

This is my first email to beginner's Perl and sincerely hope I am sending
this message to the right place.  



I want to delete some DB backup files using UNC pathing and perl. My code
segment, which does not work, is listed below. I do not get any errors when
I run this piece of code however, the files are not deleted either. Does
anyone know what is wrong with the code?   The file permissions are open to
the world, the file was not in use, and I did try using
(<\\\\myserver\\e$\\LS_DbBackUp\\stdby30dev\\*.trn
<file:///\\myserver\e$\LS_DbBackUp\stdby30dev\*.trn> > ). 

What I found out so far is that my code works with Perl version 5.005_03,
binary build 522 but not with ActivePerl-5.6.1-535-MSWin32-x86.msi or
ActivePerl-5.8.0.806-MSWin32-x86.msi. Has anyone else come across this
issue?  What did you do to resolve it?


Code segment

foreach $file (<\\\\myserver\\e\\LS_DbBackUp\\stdby30dev\\*.trn
<file:///\\myserver\e\LS_DbBackUp\stdby30dev\*.trn> > ) { 
unlink($file) || warn "file not deleted $file $!"; 
}









Thanks,

Shirley



 



--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]