A simple perl program to send data from different files - perl

I wrote a perl program which send the updated data from a file to remote server periodically. But now i want it to read it from differnt files and send the updated data such that the reciever should know how to seperate the data from the mixed data. Do i just need to put some kind of delimiter? Is there any standards already there for such things?
#############
#Change parameters
############
$PeerAddr='192.168.0.7';
$PeerPort='7070';
##############
# Import packages
##############
use Text::Diff;
use IO::Socket;
#############
# Define global variables
#############
$lineCount=0;
$loopCount=0;
our $stats2 = 0;
for($count = 0; $count <= 10000; $count++){
my $data_dir="archive/otat/*dat";
my $data_file= `ls -t $data_dir | head -1`;
chomp($changed_data_file);
print "old data_file is $changed_data_file \n";
chomp($data_file);
if($data_file ne $changed_data_file){
$lineCount2=0;
$changed_data_file=$data_file;
print ("String:$data_file :$changed_data_file are not equal\n");
}
while(defined($data_file)){
print "$data_file \n";
open (DAT,$data_file) || die("Could not open file! $!");
#iofile = <DAT>;
$lineCount = #iofile;
splice(#diffLines);
print "printing: $lineCount\n";
print "printing 2: $lineCount2 \n";
chomp $lineCount;
chomp $lineCount2;
if($lineCount != $lineCount2){
$j=0;
for($i=$lineCount2;$i <= $lineCount; $i++){
$diffLines[$j] = $iofile[$i];
$j++;
}
$num=#diffLines;
print "count of diff lines:$num\n";
$lineCount2 = $lineCount;
$loopCount=0;
}
if($loopCount>2){
$loopCount=0;
print "Look for recent file \n";
last;
}
$loopCount++;
sleep(5);
############################
&socket_con(#diffLines);
}
}
#### Methods/Functions
sub socket_con {
if ($sock== 0){
$sock = new IO::Socket::INET (
PeerAddr => $PeerAddr,
PeerPort => $PeerPort,
Proto => 'tcp'
);
die "Could not create socket: $!\n" unless $sock;
}
print $sock #_;
#close($sock);
}

I've used JSON a lot with good results http://metacpan.org/pod/JSON You can store your data in a hash, serialize it, send the text to the client and have it turn the string back into a Perl hash for easy use. For example:
# on the server
use JSON;
...
# store changed lines in a hash
$diffLines->{$data_file}[$j]=$io_file[$i];
...
# Serialize the hash reference into a string which you then send to the client
$diffLinesSerialized = encode_json $diffLines;
# on the clinet
use JSON;
...
# convert received data from serialized string into hash
$diffLines = decode_json $diffLinesSerialized;
# $diffLines is now a has reference which can be accessed like normal
foreach my $data_file (keys %$diffLines) {
foreach my $line (#{$diffLines->{$data_file}}) {
...
}
}
All this being said, as much as I don't really like XML from a programming perspective, it is a prevalent standard for this kind of thing. If this is just a specialized, internal tool that won't grow into something larger it probably doesn't matter, but if you think this could turn into a more general service, say for non-perl clients, it would be good to consider XML as an option. Programming from a service-oriented perspective can make it easier to grow things down the road.

Related

Run a LaTeX file for PDF generation

I found this code on the internet and I was deeply confused. Could you please help me out?
It seems like the file generated will be saved into a folder with name cover_letters, which should already be there. I ran the code, but I can't find the generated file at all even though no errors are given. Did I misunderstand something?
use strict;
use Schools;
sub main;
sub generate_latex;
# Set this to 1 if you want to generate cover letters for all
# schools regardless of whether their DO_GENERATE_KEY is set.
my $generate_all_ = 0;
# The directory where the files will go (should be created already).
my $cover_letter_dir_ = "cover_letters";
# The prefix that will be prepended to each file.
my $fname_pre_ = "coverletter_";
# A log file to see an errors.
my $log_file_ = "coverletter.log";
main();
sub main {
my $key;
my $num_keys = scalar(keys(%Schools::univ_));
my $ctr = 1;
print "\n";
if(-e $cover_letter_dir_."/".$log_file_) {
unlink($cover_letter_dir_."/".$log_file_);
}
my $i;
if($generate_all_ == 1) {
my #prev_fnames = glob($cover_letter_dir_."/".$fname_pre_."*");
foreach $i (#prev_fnames) {
unlink $i;
}
}
foreach $key (keys(%Schools::univ_)) {
if($generate_all_ == 1 ||
(defined $Schools::univ_{$key}{$Schools::DO_GENERATE_KEY} &&
$Schools::univ_{$key}{$Schools::DO_GENERATE_KEY} > 0)) {
print "Generating $key, $ctr of $num_keys\n";
generate_latex($key);
$ctr++;
}
}
print "\n";
}
# NOTE: You should change the LaTeX in this function
# to generate the format you desire. I used the newlfm
# and charter (a font) packages to create my files.
sub generate_latex {
my $key = shift;
my $fname = $cover_letter_dir_."/".$fname_pre_.$key.".tex";
local *OUT;
open(OUT, '>', $fname) || die "Cannot open $fname\n";
# newlfm is available at:
# http://www.tug.org/tex-archive/help/Catalogue/entries/newlfm.html
print OUT "\\documentclass[10pt,stdletter]{newlfm}\n";
print OUT "\\usepackage{charter}\n\n";
# Determines how forceful LaTeX is in making sure page breaks
# do not leave orphaned lines.
print OUT "\\widowpenalty=1000\n";
print OUT "\\clubpenalty=1000\n\n";
# Replace "figures/logo" with the logo you want to use and
# ".eps" with the extension of your file.
print OUT "\\newsavebox{\\Luiuc}\n";
print OUT "\\sbox{\\Luiuc}{%\n";
print OUT "\t\\parbox[b]{1.75in}{%\n";
print OUT "\t\t\\vspace{0.5in}%\n";
print OUT "\t\t\\includegraphics[scale=1.0,ext=.eps]\n";
print OUT "\t\t{figures/logo}%\n";
print OUT "\t}%\n";
print OUT "}%\n";
print OUT "\\makeletterhead{Uiuc}{\\Lheader{\\usebox{\\Luiuc}}}\n\n";
print OUT "\\newlfmP{headermarginskip=20pt}\n";
print OUT "\\newlfmP{sigsize=50pt}\n";
#print OUT "\\newlfmP{sigskipbefore=20pt}\n";
print OUT "\\newlfmP{dateskipafter=20pt}\n";
print OUT "\\newlfmP{addrfromphone}\n";
print OUT "\\newlfmP{addrfromemail}\n";
print OUT "\\PhrPhone{Phone}\n";
print OUT "\\PhrEmail{Email}\n\n";
print OUT "\\lthUiuc\n\n";
print OUT "\\namefrom{Your Name}\n";
print OUT "\\addrfrom{%\n";
print OUT "\tYour Street\\\\\n";
print OUT "\tBeverly Hills, CA 90210\n";
print OUT "}\n";
print OUT "\\phonefrom{217-555-5555}\n";
print OUT "\\emailfrom{you\#school.edu}\n\n";
if(defined $Schools::univ_{$key}{$Schools::ADDR_KEY}) {
if(defined $Schools::univ_{$key}{$Schools::TO_NAME_KEY}) {
print OUT "\\nameto{".
"$Schools::univ_{$key}{$Schools::TO_NAME_KEY}}\n";
}
print OUT "\\addrto{%\n";
print OUT "$Schools::univ_{$key}{$Schools::ADDR_KEY}";
print OUT "}\n\n";
}
# Specify the default string to use if no TO_NAME key is defined.
my $to_str = "To Whom It May Concern";
#my $to_str = "Dear Faculty Search Committee";
if(defined $Schools::univ_{$key}{$Schools::TO_NAME_KEY}) {
my #name = split(/ /,
$Schools::univ_{$key}{$Schools::TO_NAME_KEY});
$to_str = "Dear $name[0] $name[$#name]";
}
print OUT "\\greetto{$to_str,}\n";
print OUT "\\closeline{Sincerely,}\n";
print OUT "\\begin{document}\n";
print OUT "\\begin{newlfm}\n\n";
# Specify a default string to use if no UNIV_KEY or DEPT_KEY is defined.
my $dept_str = "your department";
if(defined $Schools::univ_{$key}{$Schools::UNIV_KEY} &&
defined $Schools::univ_{$key}{$Schools::DEPT_KEY}) {
# Make the school possessive...deal with school names ending
# in 's'.
my $poss_str = "'s";
my $name_str = $Schools::univ_{$key}{$Schools::UNIV_KEY};
if(substr($name_str,(length($name_str) - 1), 1) eq "s") {
$poss_str = "'";
}
$dept_str = "$Schools::univ_{$key}{$Schools::UNIV_KEY}$poss_str ".
"$Schools::univ_{$key}{$Schools::DEPT_KEY} Department"
}
# By default, do not include any string about your research
# background.
my $area_str = "";
if(defined $Schools::univ_{$key}{$Schools::AREA_KEY}) {
# If the ad is relevant to your specific background, use this
# string.
$area_str =
"My background is particularly applicable to your advertised\n".
"preference in the area of ".
"$Schools::univ_{$key}{$Schools::AREA_KEY}.\n";
}
# By default, do not print anything extra for the school.
my $loc_str = "";
if(defined $Schools::univ_{$key}{$Schools::LOCATION_KEY}) {
# If extra info is defined for the school, print it.
$loc_str = $Schools::univ_{$key}{$Schools::LOCATION_KEY};
}
# Here's the actual text that will go in your cover letter.
# I will leave mine in as an example, but it is NOT a template.
# DO NOT PLAGERIZE THIS!!! The cover letter should be unique
# to you. Plus, it is a well-known fact that the job gods
# look very unfavorably upon anyone that doesn't write their
# own cover letter.
print OUT "I am writing to apply for the position of assistant\n".
"professor in $dept_str. I plan to receive my\n".
"Ph.D.\\ degree from the University of Illinois at\n".
"Urbana-Champaign in Summer of 2006. My adviser is\n".
"Prof.\\ Nitin H.\\ Vaidya, and my general areas of interest\n".
"include wireless and sensor network performance and security.\n".
"$area_str $loc_str\n";
print OUT "In my graduate work, I focus on the design of\n".
"energy-efficient protocols and secure key distribution.\n".
"More specifically, I have explored various techniques at\n".
"multiple layers of the network stack to effectively reduce\n".
"the energy consumption of wireless communication. In security,\n".
"my work was the first to propose leveraging channel diversity\n".
"for sensor network key distribution. My research appears in \n".
"the \\textit{IEEE Transactions on Mobile Computing} journal as\n".
"well as \\textit{Infocom 2006} and \\textit{ICDCS 2005},\n".
"prestigious conferences in the areas of networking and distributed\n".
"systems, respectively.\n\n";
print OUT "Enclosed is my curriculum vitae (including a list of\n".
"publications), contact information for my references, a research\n".
"statement, and a teaching statement. All of my publications and\n".
"presentations are available at:\n\n";
print OUT "http://www.crhc.uiuc.edu/\$\\sim\$mjmille2/publications/\n\n";
print OUT "Please let me know if there are any other materials\n".
"or information that will assist you in processing my application.\n\n";
print OUT "Thank you for your consideration. I look forward to\n".
"hearing from you.\n\n";
print OUT "\\end{newlfm}\n";
print OUT "\\end{document}\n\n";
close OUT;
chdir($cover_letter_dir_);
# Change this command if you generate LaTeX with a different
# series of commands.
system("latexmk -pdfps $fname_pre_$key >> $log_file_ 2>&1");
chdir("..");
}

Printing Zebra Labels using Perl CGI

I am having issues printing Zebra labels from a Perl CGI, where it works on one server but not another. Also, if I run the program from the command line it works on either server. The servers are IIS 7 (don't laugh it's what I'm stuck using).
Here is the code:
use strict;
use Socket;
use CGI qw(:cgi-lib);
use CGI::Carp qw ( fatalsToBrowser );
my %formdata = Vars;
print "Content-type: text/html\r\n\r\n";
# to test running from the command line, hardcode the paramters normally passed from the web interface
# comment these out when running CGI
$formdata{printer} = "zebraprinter.mycompany.com";
$formdata{serials} = "TR16170003|Gerry's Product TR|This is a generic product where all serial numbers start with the letters TR|T~";
# initialize server and port
my $port = 9100;
# create the socket, connect to the port
socket(SOCKET,PF_INET,SOCK_STREAM,(getprotobyname('tcp'))[2]) or myExit("Can't create a socket $!\n");
connect( SOCKET, pack_sockaddr_in($port, inet_aton($formdata{printer}))) or myExit("Can't connect to port $port! \n");
foreach my $serial(split("~", $formdata{serials}))
{
my #ar = split(/\|/, $serial);
my $line;
if ($formdata{printer} =~ /label2/) # small labels
{
$line = "^XA^PRA,A,A^LH5,5^FO10,10^BCN,50,N,N,N,D^FD$ar[0]^FS";
$line .= "^FO300,10^AD,15,12^FDSerial Number:^FS";
$line .= "^FO300,30^AD,15,12^FD$ar[0]^FS^XZ";
}
else # large labels
{
$line = "^XA^PRA,A,A^LH20,20";
$line .= "^FO20,40^FWN^AT,60,10^FD Serial Number: $ar[0]^FS";
$line .= "^FO20,120^FWN^AT,60,10^FD $ar[1]^FS";
# need to hard break and limit long lines
if (length($ar[2]) > 60)
{
my $part = substr($ar[2],0,60);
$line .= "^FO20,200^FWN^AT,60,10^FD Description: $part^FS";
$part = substr($ar[2],61,74);
$line .= "^FO20,260^FWN^AT,60,10^FD$part^FS";
$line .= "^FO50,340^B3N,N,100,Y,N^FD$ar[0]^FS";
}
else
{
$line .= "^FO20,200^FWN^AT,60,10^FD Description: $ar[2]^FS";
$line .= "^FO50,280^B3N,N,100,Y,N^FD$ar[0]^FS";
}
$line .= "^XZ";
# example formatted label
#$line = qq~^XA^PRA,A,A^LH20,20^FO20,40^FWN^AT,60,10^FD Serial Number: $ar[0]^FS^FO20,120^FWN^AT,60,10^FD Product: $ar[1]^FS^FO20,200^FWN^AT,60,10^FD Description: $ar[2]^FS^FO50,280^B3N,N,100,Y,N^FD$ar[0]^FS^XZ~;
}
print SOCKET $line;
}
close SOCKET;
myExit("Labels Printed.");
sub myExit
{
my $msg = shift;
print "<script>alert('$msg')</script>";
exit;
}
I'm guessing it has something to do with opening sockets in a CGI but I don't have a whole lot of experience with that.
Thanks in advance
It turns out that our Zebra printer is sending a response after printing labels and waiting to verify it was delivered, which locked it up. The solution that is working so far is to get the response but also set a short timeout on the socket just in case. Also went up the food chain and used IO::Socket instead of the old Socket library:
use strict;
use IO::Socket;
use CGI qw(:cgi-lib);
use CGI::Carp qw ( fatalsToBrowser );
my %formdata = Vars;
print "Content-type: text/html\r\n\r\n";
# to test running from the command line, hardcode the paramters normally passed from the web interface
# comment these out when running CGI
$formdata{printer} = "zebralabel1.mycompany.com";
$formdata{serials} = "TR16170003|Gerry's Product TR|This is a generic product where all serial numbers start with the letters TR|T~";
# create the socket, connect to the port
my $remote = IO::Socket::INET->new(
Proto => 'tcp',
PeerAddr=> "$formdata{printer}",
PeerPort=> "9100",
ReuseAddr=> 0,
Timeout => 2,
) or myExit("Cannot connect to printer: $!");
$remote->autoflush(1); # Send immediately
my ($serial, $product, $desc) = split(/\|/, $formdata{serials});
# example formatted label
my $line = qq~^XA^PRA,A,A^LH20,20^FO20,40^FWN^AT,60,10^FD Serial Number: $serial^FS^FO20,120^FWN^AT,60,10^FD Product: $product^FS^FO20,200^FWN^AT,60,10^FD Description: $desc^FS^FO50,280^B3N,N,100,Y,N^FD$serial^FS^XZ~;
print $remote $line;
my $dontCare = <remote>;
close $remote;
myExit("Labels Printed.");
sub myExit
{
my $msg = shift;
print "<script>alert('$msg')</script>";
exit;
}

Reading from Perl pipe constantly outputting text

I recently tried to make a game server controller in Perl, I would like to start, stop and view the text that has been outputted by the game server, this is what I have so far:
#!/usr/bin/perl -w
use IO::Socket;
use Net::hostent; # for OO version of gethostbyaddr
$PORT = 9050; # pick something not in use
$server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => SOMAXCONN,
Reuse => 1);
die "can't setup server" unless $server;
print "[Server $0 accepting clients]\n";
while ($client = $server->accept()) {
$client->autoflush(1);
print $client "Welcome to $0; type help for command list.\n";
$hostinfo = gethostbyaddr($client->peeraddr);
printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
print $client "Command? ";
while ( <$client>) {
next unless /\S/; # blank line
if (/quit|exit/i) {
last; }
elsif (/some|thing/i) {
printf $client "%s\n", scalar localtime; }
elsif (/start/i ) {
open RSPS, '|java -jar JARFILE.jar' or die "ERROR STARTING: $!\n";
print $client "I think it started...\n Say status for output\n"; }
elsif (/stop/i ) {
print RSPS "stop";
close(RSPS);
print $client "Should be closed.\n"; }
elsif (/status/i ) {
$output = <RSPS>;
print $client $output; }
else {
print $client "Hmmmm\n";
}
} continue {
print $client "Command? ";
}
close $client;
}
I am having trouble reading from the pipe, any ideas?
Thanks!
You are trying to do both reading and writing on the RSPS filehandle, though you have only opened it for writing (open RSPS, '|java -jar JARFILE.jar' means start the java process and use the RSPS filehandle to write to the standard input of the java process).
To read the output of the process, you will either need to write the process output to a file and open a separate filehandle to that file
open RSPS, '| java -jar JARFILE.jar > jarfile.out';
open PROC_OUTPUT, '<', 'jarfile.out';
or check out a module like IPC::Open3, which was made for applications like this.
use IPC::Open3;
# write to RSPS and read from PROC_OUTPUT and PROC_ERROR
open3(\*RSPS, \*PROC_OUTPUT, \*PROC_ERROR,
'java -jar JARFILE.jar');

How To Avoid a Perl script calling an Another Perl Script

i am calling a perl script client.pl from a main script to capture the output of client.pl
in #output.
is there anyway to avoid the use of these two files so i can use the output of client.pl in main.pl itself
here is my code....
main.pl
=======
my #output = readpipe("client.pl");
client.pl
=========
#! /usr/bin/perl -w
#use strict;
use Socket;
#initialize host and port
my $host = shift || $FTP_SERVER;
my $port = shift || $CLIENT_PORT;
my $proto = getprotobyname('tcp');
#get the port address
my $iaddr = inet_aton($host);
my $paddr = sockaddr_in($port, $iaddr);
#create the socket, connect to the port
socket(SOCKET, PF_INET, SOCK_STREAM, $proto)or die "socket: $!\n";
connect(SOCKET, $paddr) or die "connect: $!\n";
my $line;
while ($line = <SOCKET>)
{
print "$line\n";
}
close SOCKET or die "close: $!";
/rocky..
Put the common code in a package. Use the package in client.pl and main.pl. Chapter 10 of Programming Perl has more information.
Not sure what you are really trying to do, but might worh investigating a package such as Net::FTP ( http://search.cpan.org/perldoc?Net%3A%3AFTP )
you can do two things:
Merge the codes in client.pl and main.pl as your main function does no work other than printing. In case you want to do more from the incoming input data, you should do that in client.pl itself, coz an in-memory array(#output) may run out of RAM while reading large size data across the network.
If you want the output in an array (#output)
sub client {
# intialize ..
my #array = (); #empty array
while ($line = <SOCKET>)
{
push(#array,$line);
}
return #array;
}
#output = client();
print #output;
Other way, you can also use references:
sub client {
# intialize ..
my #array = (); #empty array
while ($line = <SOCKET>)
{
push(#array,$line);
}
return #array;
}
my $output_ref = client();
print #$output_ref; // dereference and print.

How do I determine whether a Perl file handle is a read or write handle?

You are given either an IO::File object or a typeglob (\*STDOUT or Symbol::symbol_to_ref("main::FH")); how would you go about determining if it is a read or write handle? The interface cannot be extended to pass this information (I am overriding close to add calls to flush and sync before the actual close).
Currently I am attempting to flush and sync the filehandle and ignoring the error "Invalid argument" (which is what I get when I attempt to flush or sync a read filehandle):
eval { $fh->flush; 1 } or do {
#this seems to exclude flushes on read handles
unless ($! =~ /Invalid argument/) {
croak "could not flush $fh: $!";
}
};
eval { $fh->sync; 1 } or do {
#this seems to exclude syncs on read handles
unless ($! =~ /Invalid argument/) {
croak "could not sync $fh: $!";
}
};
Have a look at the fcntl options. Maybe F_GETFL with O_ACCMODE.
Edit: I did a little googling and playing over lunch and here is some probably non-portable code but it works for my Linux box, and probably any Posix system (perhaps even Cygwin, who knows?).
use strict;
use Fcntl;
use IO::File;
my $file;
my %modes = ( 0 => 'Read only', 1 => 'Write only', 2 => 'Read / Write' );
sub open_type {
my $fh = shift;
my $mode = fcntl($fh, F_GETFL, 0);
print "File is: " . $modes{$mode & 3} . "\n";
}
print "out\n";
$file = new IO::File();
$file->open('> /tmp/out');
open_type($file);
print "\n";
print "in\n";
$file = new IO::File();
$file->open('< /etc/passwd');
open_type($file);
print "\n";
print "both\n";
$file = new IO::File();
$file->open('+< /tmp/out');
open_type($file);
Example output:
$ perl test.pl
out
File is: Write only
in
File is: Read only
both
File is: Read / Write