calling system command 2

philnewbie · Aug 6, 2009

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 · Aug 6, 2009

To call the system command use system() function

philnewbie · Aug 6, 2009

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 · Aug 6, 2009

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:

Code:

[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 · Aug 6, 2009

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! [wiggle]

mikrom · Aug 6, 2009

Hi Kevin,

I tried it:

Code:

[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 · Aug 6, 2009

That worked great. Thanks for your help!

Annihilannic · Aug 8, 2009

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

Annihilannic.

mikrom · Aug 8, 2009

Yes Kevin wrote it - mentioned here:

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

KevinADC · Aug 8, 2009

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! [wiggle]

Annihilannic · Aug 8, 2009

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

Annihilannic.

mikrom · Aug 9, 2009

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

Code:

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 · Aug 9, 2009

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! [wiggle]

KevinADC · Aug 9, 2009

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:

Code:

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! [wiggle]

mikrom · Aug 9, 2009

Thanks !

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

calling system command 2

philnewbie

Programmer

mikrom

Programmer

philnewbie

Programmer

mikrom

Programmer

KevinADC

Technical User

mikrom

Programmer

philnewbie

Programmer

Annihilannic

MIS

mikrom

Programmer

KevinADC

Technical User

Annihilannic

MIS

mikrom

Programmer

KevinADC

Technical User

KevinADC

Technical User

mikrom

Programmer

Similar threads

Part and Inventory Search

Sponsor