calling system command 2

[philnewbie]

Hi,
I am very new at Perl. I am trying to modify a script created by a co-worker that is no longer with the company. The script saves files based on their name. What I want to add is a print function to print the file. It is a pdf, and I can call the following command from a dos prompt to print the file.

acrord32.exe /t "file name" "printer share" or like this:
C:\Program Files\Adobe\Reader 9.0\Reader>acrord32.exe /t "c:\Documents and Settings\pgergen\Desktop\Verizon Bill.pdf" "\\redwdc001\rw_infosys"

I want to call this command from the script either before or after it saves the file. Below is my current script that I am trying to modify. Any help would be greatly appreciated. Thanks.

#!/Perl/bin/perl -w
use File::Copy;
$server_type = "windows";
##########################################################
# Your directories must have the trailing slash
##########################################################
$readdir = "G:/At_Work2/Work/AutoFile/PaperProof/";
$savedir = "G:/At_Work2/Work/";
$tempdir = "G:/At_Work2/Work/AutoFile/TempAutoFile/";
$badname = "G:/At_Work2/Work/AutoFile/TempAutoFile/BadFileNames/PaperProof/";
##########################################################
# Uncomment these 3 lines if being run on a Mac server
##########################################################
# $server_type = "mac";
# use Mac::Memory;
# use Mac::Resources;
##########################################################
$longdate = "";
# check for the temp folder and create if it doesn't exist
if(!-d $tempdir)
{
mkdir($tempdir);
}
if(!-d $badname)
{
mkdir($badname);
}
# get the current date (day only)
($Second, $Minute, $Hour, $Day, $Month, $Year, $WeekDay, $DayOfYear, $IsDST) = localtime(time);
# use all the
$longdate = ($Minute."-".$Hour."-".$Day."-".$Month.$Year.$WeekDay.$DayOfYear.$IsDST);
if ($Day < 0)
{
$Day = "0".$Day;
}
$newbadname = ($Second);
$tdtempdir = ($tempdir.$Day);
if(!-d $tdtempdir)
{
mkdir($tdtempdir);
}
# if $readdir is a folder (directory)
if(-d $readdir)
{
# try to list folder, on error display message "Cannot open..." and quit
opendir(RDIR, $readdir) || die "Cannot opendir $readdir: $!";
# sort the list
foreach $name (sort readdir(RDIR))
{
# if the name isn't: ".", "..", and isn't locked and isn't a plain text file
if($name ne "." && $name ne ".." && !($name =~ m/\.loc$/) && !($name =~ m/^\./) && -f $readdir.$name)
{
print $name."\n";
if(-f $readdir.$name.".loc")
{
print " Locked\n";
}
else
{
# set LOCF to the file and open it with read/write access
open(LOCF, ">".$readdir.$name.".loc");
close(LOCF);
#print " Not Locked\n";
# set $s1 to the file size
$s1 = (-s $readdir.$name);
# sleep(1);
#set $s2 to the file size
$s2 = (-s $readdir.$name);
# if the file sizes are equal (ergo file isn't still saving/in use)
if($s1 == $s2)
{
########################################
# The Buck Starts Here
########################################
#*********************************************************
$tname = $name;
# delete alpha characters from the file name, commented out for red wing
# $tname =~ s/[a-zA-Z]//g;
# globally replace underscores, plus symbols, slashes, spaces, tabs and ñ with a dash
$tname =~ s/[_\+\/\s\t\.ñ\\:\*\^\+\?<>\"\|]/-/g;
# create an array called @tn2 of the text items of $tname?
@tn2 = split(/-/, $tname);
# set $tname to the first text item (ostensibly the SO number) of $tn2
$tname = $tn2[0];
#############################
# Z:\art_search\new\1150000-1199999\1156000-1156999\1156700-1156799\1156779-mi
# create the subfolder names from the file name
$td0 = $tname;
$td1 = $tname;
$td2 = $tname;
# $td3 = $tname; # uncomment this line if breaking folders down to thousands
$td4 = $tname;

$td0 =~ s/[0-9]{5}$//g;
$td1 =~ s/[0-9]{4}$//g;
$td1a = $td1;
$td1a =~ s/[a-zA-Z]//g;
if ($td0 !~ m/[a-zA-Z]/)
{
if(-e $badname.$name)
{copy($readdir.$name, $badname.$newbadname."-".$name);
unlink($readdir.$name); # deletes the original file
unlink($readdir.$name.".loc"); # deletes the lock file
$newbadname = ++$newbadname;
print $name." moved to ".$badname."\n";
}
elsif (!-e $badname.$name)
{
copy($readdir.$name, $badname.$name);
unlink($readdir.$name); # deletes the original file
unlink($readdir.$name.".loc"); # deletes the lock file
print $name." moved to ".$badname."\n";
}
}
$td4 =~ s/$td0{1}//g;
if ($td4 !~ m/[0-9]/)
{
if(-e $badname.$name)
{copy($readdir.$name, $badname.$newbadname."-".$name);
unlink($readdir.$name); # deletes the original file
unlink($readdir.$name.".loc"); # deletes the lock file
$newbadname = ++$newbadname;
print $name." moved to ".$badname."\n";
}
elsif (!-e $badname.$name)
{
copy($readdir.$name, $badname.$name);
unlink($readdir.$name); # deletes the original file
unlink($readdir.$name.".loc"); # deletes the lock file
print $name." moved to ".$badname."\n";
}
}
else
{
if(-d $savedir.$td0."00000-".$td0."99999")
{
$savedir = ($savedir.$td0."00000-".$td0."99999");
$savedir = $savedir."/";
}

$ndir = $td0.$td1a."0000";
$ndir = $ndir ."-". ($td0.$td1a."9999");
if(!-d $savedir.$ndir)
{
mkdir($savedir.$ndir);
}
#############################################################
$td2 =~ s/[0-9]{3}$//g;
$td2 = $td2 . "000-".$td2."999";
$ndir = $ndir . "/" . $td2;
if(!-d $savedir.$ndir)
{
mkdir($savedir.$ndir);
}
#####################################
# 1000s subfolder, red wing stops at 10k
# $td3 =~ s/[0-9]{2}$//g;
# $td3 = $td3 . "00-".$td3."99";
# $ndir = $ndir . "/" . $td3;
# if(!-d $savedir.$ndir)
# {
# mkdir($savedir.$ndir);
# }
#####################################
if(!-d $savedir.$ndir."/".$tname)
{
mkdir($savedir.$ndir."/".$tname);
}
if (!-d $savedir.$ndir."/".$tname."/"."Correspondence")
{
mkdir ($savedir.$ndir."/".$tname."/"."Correspondence");
}
#*********************************************************
$nname = $name;
$nname =~ s/[".pdf"]/_PP./o;
print "new name ".$nname."\n";
$nfile = $ndir."/".$tname."/"."Correspondence"."/".$nname;
if($server_type eq "windows")
{
if(-e $savedir.$nfile)
{
copy($savedir.$nfile, $tdtempdir."/".$nname);
}

copy($readdir.$name, $savedir.$nfile);
}


elsif ($server_type eq "mac")
{
if(-e $savedir.$nfile)
{
system 'ditto', '-V', '-rsrcFork', $savedir.$nfile, $tdtempdir."/".$name;
}

system 'ditto', '-V', '-rsrcFork', $readdir.$name, $savedir.$nfile;
}

if( (-s $readdir.$name) == (-s $savedir.$nfile) )
{
print " Copied Correctly\n";
unlink($readdir.$name); # deletes the original file
unlink($readdir.$name.".loc"); # deletes the lock file

}
else
{
print " File did not copy correctly\n";
print " Orig: ".$readdir.$name."\n";
print " Newf: ".$savedir.$nfile."\n";
}

########################################
# The Buck Stops Here
########################################
}
}
}
}
}
}
else
{
print "Directory not good ".$readdir."\n";
}

#########################################################

print "DONE";

exit;

 

[mikrom]

To call the system command use system() function

 

[philnewbie]

I have been trying that but I haven't been able to get the syntax correct. I was hoping someone could help with that.

 

[mikrom]

You must first compose your command properly, then it will work.
E.g. if I want to print the document IBAN.pdf from my home path I do this and it works:

[COLOR=#804040][b]use strict[/b][/color];
[COLOR=#804040][b]use warnings[/b][/color];

[COLOR=#804040][b]my[/b][/color] [COLOR=#008080]$adobe_reader[/color]=[COLOR=#ff00ff]'[/color][COLOR=#ff00ff]"C:\Program Files\Adobe\Reader 8.0\Reader\acrord32.exe"[/color][COLOR=#ff00ff]'[/color];
[COLOR=#804040][b]my[/b][/color] [COLOR=#008080]$file_path[/color]=[COLOR=#ff00ff]'[/color][COLOR=#ff00ff]"C:\Documents and Settings\mikl1071\My Documents\IBAN.pdf"[/color][COLOR=#ff00ff]'[/color];

[COLOR=#0000ff]# compose command[/color]
[COLOR=#804040][b]my[/b][/color] [COLOR=#008080]$cmd[/color]=[COLOR=#ff00ff]"[/color][COLOR=#008080]$adobe_reader[/color][COLOR=#ff00ff] /t [/color][COLOR=#008080]$file_path[/color][COLOR=#ff00ff]"[/color];
[COLOR=#804040][b]print[/b][/color] [COLOR=#ff00ff]"[/color][COLOR=#6a5acd]\$[/color][COLOR=#ff00ff]cmd = [/color][COLOR=#008080]$cmd[/color][COLOR=#6a5acd]\n[/color][COLOR=#ff00ff]"[/color];

[COLOR=#0000ff]# execute command[/color]
[COLOR=#804040][b]my[/b][/color] [COLOR=#008080]$rc[/color]=[COLOR=#804040][b]system[/b][/color]([COLOR=#008080]$cmd[/color]);
[COLOR=#804040][b]print[/b][/color] [COLOR=#ff00ff]"[/color][COLOR=#6a5acd]\$[/color][COLOR=#ff00ff]rc = [/color][COLOR=#008080]$rc[/color][COLOR=#6a5acd]\n[/color][COLOR=#ff00ff]"[/color]

 

[KevinADC]

mikrom,

you're welcome to use this Perl to TGML converter if you want to:

http://www.e-pixs.com/highlight/

------------------------------------------
- Kevin, perl coder unexceptional!

 

[mikrom]

Hi Kevin,

I tried it:

[url=http://perldoc.perl.org/functions/use.html][black][b]use[/b][/black][/url] [green]strict[/green][red];[/red]
[black][b]use[/b][/black] [green]warnings[/green][red];[/red]

[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$adobe_reader[/blue]=[red]'[/red][purple]"C:\Program Files\Adobe\Reader 8.0\Reader\acrord32.exe"[/purple][red]'[/red][red];[/red]
[black][b]my[/b][/black] [blue]$file_path[/blue]=[red]'[/red][purple]"C:\Documents and Settings\mikl1071\My Documents\IBAN.pdf"[/purple][red]'[/red][red];[/red]

[gray][i]# compose command[/i][/gray]
[black][b]my[/b][/black] [blue]$cmd[/blue]=[red]"[/red][purple][blue]$adobe_reader[/blue] /t [blue]$file_path[/blue][/purple][red]"[/red][red];[/red]
[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple][purple][b]\$[/b][/purple]cmd = [blue]$cmd[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]

[gray][i]# execute command[/i][/gray]
[black][b]my[/b][/black] [blue]$rc[/blue]=[url=http://perldoc.perl.org/functions/system.html][black][b]system[/b][/black][/url][red]([/red][blue]$cmd[/blue][red])[/red][red];[/red]
[black][b]print[/b][/black] [red]"[/red][purple][purple][b]\$[/b][/purple]rc = [blue]$rc[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red]

[tt]------------------------------------------------------------
Pragmas (perl 5.10.0) used :
[ul]
[li]strict - Perl pragma to restrict unsafe constructs[/li]
[li]warnings - Perl pragma to control optional warnings[/li]
[/ul]
[/tt]

Very nice !!! Thank you !

 

[philnewbie]

That worked great. Thanks for your help!

 

[Annihilannic]

Handy converter that Kevin... did you write it?

Annihilannic.

 

[mikrom]

Yes Kevin wrote it - mentioned here:

http://www.tek-tips.com/viewthread.cfm?qid=1520510

 

[KevinADC]

The perl to TGML convertor is an existing CPAN module that I modified to add TGML code and the links to perldoc and some other modifications I no longer remember.

http://search.cpan.org/~johnsca/Syntax-Highlight-Perl-1.0/lib/Syntax/Highlight/Perl.pm

The two scripts can be downloaded from here for anyone interested:

http://www.e-pixs.com/tgml

they are not documented because they were never meant for distribution but any fairly good perl coder will figure them out.



------------------------------------------
- Kevin, perl coder unexceptional!

 

[Annihilannic]

Thanks, off topic, but have a star for that anyway!

Annihilannic.

 

[mikrom]

I cannot download the second file tekify.cgi.txt, if I try it I get

Directory has no index file.
Browsing this site or directory without an index file is prohibited.
If you are the site's webmaster, you can remedy this problem by creating a default HTML page with one of the following names:
index.html
index.htm
default.htm
Default.htm
home.html
Home.chtml
NOTE: Filenames are case sensitive, i.e., Home.html is not the same as home.html

 

[KevinADC]

Sorry, I renamed it tekify.txt so you can get the source code now. Rename it to .cgi or .pl if your server requires one of those extensions to execute a perl script.

------------------------------------------
- Kevin, perl coder unexceptional!

 

[KevinADC]

The Perl.pm file should go in a directory name Syntax/Highlight (Syntax::Highlight) relative to the directory where tekify.cgi is stored or you could add it to @INC with the lib pragma. Its pure perl so doesn't have to be installed, you can just upload the source code. tekify.cgi has the color definitions for the highlighting:

my %colors = (
    Variable             => 'blue',
    Number               => 'fuchsia',
    Comment_POD          => 'gray',
    Directive            => 'gray',
    Package              => 'green',
    Subroutine           => 'maroon',
    Label                => 'maroon',
    Line                 => 'maroon',
    String               => 'purple',
    Quote                => 'red',
    Symbol               => 'red',
    CodeTerm             => 'teal',
    DATA                 => 'teal', 
);
my %colors_black_bold = (
    Builtin_Operator     => '[b]',
    Builtin_Function     => '[b]',
);

my %colors_other = (
    Keyword              => '[olive][b]',
    Character            => '[purple][b]',
    Comment_Normal       => '[gray][i]',
);

change those to whatever you prefer.

Keep in mind, it turns perl code into TGML code, not HTML code. Tek-Tips internal script is what changes the TGML code into HTML code. The "preview" subroutine in tekify.cgi does convert into html for the preview but thats is just a temporary transformation so you can see what the perl/TGML code will look like when you post it on Tek-Tips, although if Tek-Tips ever makes changes to their TGML parser the preview in tekify.cgi may not match with Tek-Tips and there might be subtle differences that I never noticed. This was just a fun project a did a while back one weekend and never meant as a serious bullet-proof application although it should be secure and not allow any funny business but let me know if you notice any weakness/vulnerability in the scripts.

------------------------------------------
- Kevin, perl coder unexceptional!

 

[mikrom]

Thanks !