I have a program which brings in a page for a book using HTML::TagParser and the book's barcode, grabs a certain span, repeats it for a different page, and then adds it to a TK::MListbox until chosen to export it. This works perfectly fine in Eclipse. However, once made an .exe with par-packer, the program fails to work. The error when using barcode 31412007436751 is this:
Tk::Error: URI::Fetch failed: https://i-share.carli.illinois.edu/uis/cgi-bin/shelflister.cgi?search=s1&bcs=31412007436751&bce=&stpt=1&mode=1 at script/ShelfLister_Lister.pl line 32.
Carp::croak at C:/strawberry/perl/lib/Carp.pm line 100
HTML::TagParser::fetch at HTML/TagParser.pm line 261
HTML::TagParser::new at HTML/TagParser.pm line 239
main::addBook at script/ShelfLister_Lister.pl line 32
<Key-Return>
(command bound to event)
The related program code is this:
#!/user/bin/perl
use strict;
use warnings;
use Tk;
use Tk::MListbox;
use LWP::Simple;
use URI::Fetch;
use Encode::Byte;
use HTTP::Response;
use HTML::TagParser;
use Spreadsheet::WriteExcel;
my ($callNumber, $title, $html, $numItems);
my $savetypes = [['Excel Files', '.xls'], ['Comma-Separated Files', '.csv'], ['Text Files', '.txt']];
my $mw = new MainWindow;
$mw->title("Barcode Lister");
$mw->Label(-text=>'Choose Books')->grid(-row=>1, -column=>1, -columnspan=>2, -pady=>10);
my $barcode = $mw->Entry(-width=>50)->grid(-row=>2, -column=>1, -pady=>5, -padx=>[5, 10]);
my $add = $mw->Button(-text=>'Add Record', -command=>\&addBook, -width=>15)->grid(-row=>2, -column=>2, -pady=>5);
my $listFrame = $mw->Frame(-bd=>2, -relief=>"sunken")->grid(-row=>3, -column=>1, -padx=>[5, 10], -pady=>5);
my $list = $listFrame->Scrolled(qw(MListbox -background white -scrollbars oe))->pack(-expand=>1, -fill=>"both");
$list->columnInsert('end', -text=>"Call number", -width=>23);
$list->columnInsert('end', -text=>"Title", -width=>25);
my $delete = $mw->Button(-text=>'Delete Record', -command=>\&removeBook, -width=>15)->grid(-row=>3, -column=>2, -pady=>5);
my $export = $mw->Button(-text=>'Export List', -command=>\&exportList, -width=>15)->grid(-row=>4, -column=>1, -columnspan=>2, -pady=>5);
$barcode->bind('<Return>'=>\&addBook);
$barcode->focus;
MainLoop;
sub addBook{
$html = HTML::TagParser->new('https://i-share.carli.illinois.edu/uis/cgi-bin/shelflister.cgi?search=s1&bcs=' . $barcode->get() . '&bce=&stpt=1&mode=1');
$title = $html->getElementsByClassName('listLine');
if (ref $title){
$html = HTML::TagParser->new('https://i-share.carli.illinois.edu/uis/cgi-bin/shelflister.cgi?search=s1&bcs=' . $barcode->get() . '&bce=&stpt=1&mode=2');
$list->insert("end", [$title->innerText(), $html->getElementsByClassName('listLine')->innerText()]);
$barcode->delete(0, 'end');
}
else{
$mw->messageBox(-title=>'Error', -message=>"Barcode not found.", -type=>'Ok', -icon=>'error', -default=>'ok');
}
}
Anyone have any ideas on how I could get this to work as an .exe?
Probably URI::Fetch->errstr would give more information on the failure. Either try to patch HTML::TagParser (see https://rt.cpan.org/Ticket/Display.html?id=86698) or maybe it's possible to wrap your HTML::TagParser-related code lines into an eval { } and call the errstr function yourself on errors.
Related
I am new using Perl language, and I am following a book to begin with some advanced scanning network (as that's why I am learning Perl for)
so the program looks like that:
#!/usr/bin/perl -w
use strict;
use Net::Pcap qw( :functions );
use Net::Frame::Device;
use Net::Netmask;
use Net::Frame::Dump::Online;
use Net::ARP;
use Net::Frame::Simple;
my $err = "";
my $dev = pcap_lookupdev(\$err); # from Net::Pcap
my $devProp = Net::Frame::Device->new(dev => $dev);
my $ip = $devProp->ip;
my $gateway = $devProp->gatewayIp;
my $netmask = new Net::Netmask($devProp->subnet);
my $mac = $devProp->mac;
my $netblock = $ip . ":" . $netmask->mask();
my $filterStr = "arp and dst host ".$ip;
my $pcap = Net::Frame::Dump::Online->new(
dev => $dev,
filter => $filterStr,
promisc => 0,
unlinkOnStop => 1,
timeoutOnNext => 10 # waiting for ARP responses
);
$pcap->start;
print "Gateway IP: ",$gateway,"\n","Starting scan\n";
for my $ipts ($netmask->enumerate){
Net::ARP::send_packet(
$dev,
$ip,
$ipts,
$mac,
"ff:ff:ff:ff:ff:ff", # broadcast
"request");
}
until ($pcap->timeout){
if (my $next = $pcap->next){ # frame according to $filterStr
my $fref = Net::Frame::Simple->newFromDump($next);
# we don’t have to worry about the operation codes 1, or 2
# because of the $filterStr
print $fref->ref->{ARP}->srcIp," is alive\n";
}
}
END{ print "Exiting\n"; $pcap->stop; }
However, when I run ./script.pl I am getting this error:
Undefined subroutine &main::pcap_lookupdev called at ./scan_ARP.pl line 13.
Exiting
Can't call method "stop" on an undefined value at ./scan_ARP.pl line 48.
END failed--call queue aborted.
and as mentionned in the book, I can replace my $dev = pcap_lookupdev(\$err); directly with my $dev = "wlp0s20f3" (wlp0s20f3; is the name of my network interface), but when I do that, I get:
[-]: Net::Frame::Dump::Online: Must be EUID 0 (or equivalent) to open a device for live capture
Exiting
Can't kill a non-numeric process ID at /usr/share/perl5/Net/Frame/Dump/Online.pm line 363.
END failed--call queue aborted.
So I found out that to solve the problem, I have to run the script as a root.
We are writing a Perl code (to be run from Unix) which will reset the password of a Windows AD User. (We are not using powershell as we have been asked not to use Windows scripts).
With the following Perl code, we are able to connect to the AD User directory and query the correct user.
#!/usr/bin/perl -w
#########################
#This script resets the password in active user directory
#########################
use strict;
use warnings;
use DBI;
use Net::LDAP;
use Net::LDAPS;
use Authen::SASL qw(Perl);
use Net::LDAP::Control::Paged;
use Time::Local;
my $CERTDIR = "<cert path>";
my $AD_PASS = "$CERTDIR/.VDIAD_pass";
my $sAN = "vahmed";
### Generate Random Password ###
my $randompass = askPasswd();
my $uninewpass;
my $mail;
my $fullname;
my $name;
my $distName;
my $finalresult;
my #AD_passwords = get_domain_pass();
my $result = reset_AD_Password();
#Reset AD user password
sub reset_AD_Password {
my $ad = Net::LDAP->new($AD_passwords[0]);
my $msg = $ad->bind(dn => "cn=$AD_passwords[2],$AD_passwords[1]",
password => $AD_passwords[3],
version => 3);
if ($msg->code)
{
print "Error :" . $msg->error() . "\n";
exit 2;
}
my $acc_name = 'sAMAccountName';
my $acc_fullname = 'displayName';
my $acc_base = 'manager';
my $acc_distName = 'distinguishedName';
my $acc_mail = 'mail';
my $act = $ad->search(
base => "$AD_passwords[1]",
filter => "(&(objectCategory=person)(sAMAccountName=$sAN))",
attrs => [$acc_name, $acc_fullname, $acc_distName, $acc_mail]);
die 1 if ($act->count() !=1 );
my $samdn = $act->entry(0)->dn;
$fullname = $samdn->get_value($acc_fullname);
$mail = $samdn->get_value($acc_mail);
}
}
However we get an error on the line:
$fullname = $samdn->get_value($acc_fullname);
$mail = $samdn->get_value($acc_mail);
The error states "Can't locate object method "get_value" via package (distinguished Name) (perhaps you forgot to load (distinguished Name))"
However the code works correctly when we replace $samdn with the following code:
foreach my $entry ($act->entries){
$name = $entry->get_value($acc_name);
$fullname = $entry->get_value($acc_fullname);
$distName = $entry->get_value($acc_distName);
$mail = $entry->get_value($acc_mail);
}
It would appear that the code is unable to identify $samdn as a Net::LDAP::Entry record.
We have tried typecasting $samdn but got the same error.
Could someone help in resolving this issue as we would not prefer to use the for loop just in case more that one record is returned by the search? Thanks in advance.
You are not assigning a Net::LDAP::Entry to $samdn. You are assigning the dn of the first entry.
# VVVV
my $samdn = $act->entry(0)->dn;
Get rid of that ->dn and it should work, if $act->entry(0) returns a Net::LDAP::Entry.
I am having quite the issue creating a new line with this module and feel like I am just missing something.
my perl code looks like this:
use OpenOffice::OODoc;
my $name = "foo <br> bar";
$name=~s/<br>/\n/g;
my $outdir = "template.odt";
my $doc = ooDocument(file => $outdir);
my #pars = $doc->getParagraphList();
for my $p (#pars)
{
$doc->substituteText($p,'{TODAY}',$date);
$doc->substituteText($p,'{NAME}',$name);
...
Problem is when I open it in word or open office I have no newlines. Although if it open it in a text edit I have my new lines.. Any ideas of how to fix this?
Ok I figured it out, hopefully this will save someone hours of searching for the same thing. I added:
use Encode qw(encode);
ooLocalEncoding('utf8');
my $linebreak = encode('utf-8', "\x{2028}");
$doc->substituteText($p,'<br>', $linebreak);
So my final code looks like this:
use OpenOffice::OODoc;
use Encode qw(encode);
ooLocalEncoding('utf8');
my $linebreak = encode('utf-8', "\x{2028}");
my $outdir = "template.odt";
my $name = "foo <br> bar";
my $outdir = "template.odt";
my $doc = ooDocument(file => $outdir);
my #pars = $doc->getParagraphList();
for my $p (#pars)
{
$doc->substituteText($p,'{TODAY}',$date);
$doc->substituteText($p,'{NAME}',$name);
$doc->substituteText($p,'<br>', $linebreak);
...
Maybe not the best way to do things but it worked!
You could try and insert and empty para after the current one:
If the 'text' option is empty, calling this method is the equivalent
of adding a line feed.
This sequence (in a text document) inserts a linefeed immediately after paragraph 4. Replace 4 with current position.
$doc->insertElement
(
'//text:p', 4, 'text:p',
position => 'after',
text => '',
);
I'm trying to add a menubar with the standard File Open, Save and New options.
However, instead of behaving as expected, the subroutine handling the open, save and new actions is launched upon creation of the frame. But, when I actually click on them, it is not.
Following is the code I'm using. (Main window contains only the menubar)
#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
use Data::Dumper;
use Tk 8.0;
use Tk::NoteBook;
use Tk::MsgBox;
my $mw=MainWindow->new;
$mw->geometry("+500+300");
# Menu Bar Buttons
my $mbar=$mw->Menu();
$mw->configure(-menu => $mbar);
my $file=$mbar->cascade(-label=>"~File", -tearoff => 0);
my $help=$mbar->cascade(-label =>"~Help", -tearoff => 0);
# File Menu
$file->command(-label =>'~New ', -command=>&menu_file('n'), -accelerator=>'Ctrl+N');
$file->command(-label =>'~Open ', -command=>&menu_file('o'), -accelerator=>'Ctrl+O');
$file->command(-label =>'~Save ', -command=>&menu_file('s'), -accelerator=>'Ctrl+S');
$file->separator();
$file->command(-label =>'~Quit ', -command=>sub{exit}, -accelerator=>'Ctrl+Q');
# Help Menu
$help->command(-label => 'Version');
$help->separator;
$help->command(-label => 'About');
# Menu Bar Accelerators
$mw->bind('<Control-n>', &menu_file('n'));
$mw->bind('<Control-o>', &menu_file('o'));
$mw->bind('<Control-s>', &menu_file('s'));
$mw->bind('<Control-q>', sub{exit});
MainLoop;
sub menu_file {
my $opt=shift;
my $filetypes = [
['Codac files', '.k'],
['All Files', '*' ],
];
if($opt eq 's'){
my $txt_ent_script = $mw->getSaveFile(-filetypes=>$filetypes, -initialfile=>'jitter', -defaultextension=>'.k');
print "Output filename: $txt_ent_script\n";
}
}
That's because &menu_file('n') is syntax for invoking a subroutine (more details). Instead, you have to do it like this:
$mw->bind('<Control-n>' => sub{menu_file('n')});
Or like this:
$mw->bind('<Control-n>' => [\&menu_file, 'n']);
I have been tinkering around with PDF::API2 and i am facing a problem, create a pdf file very well and add text into it. However say if the text to be written flows over to more than one page, the script does not print over to the next page. I have tried researching for an answer to this but to no avail. I would like each page to have exactly 50 lines of text. My script is as below. It only prints on the first page, creates the other pages but does not print into them. Anyone with a solution
!/usr/bin/perl
use PDF::API2;
use POSIX qw(setsid strftime);
my $filename = scalar(strftime('%F', localtime));
my $pdf = PDF::API2->new(-file => "$filename.pdf");
$pdf->mediabox(595,842);
my $page = $pdf->page;
my $fnt = $pdf->corefont('Arial',-encoding => 'latin1');
my $txt = $page->text;
$txt->textstart;
$txt->font($fnt, 20);
$txt->translate(100,800);
$txt->text("Lines for $filename");
my $i=0;
my $line = 780;
while($i<310)
{
if(($i%50) == 0)
{
my $page = $pdf->page;
my $fnt = $pdf->corefont('Arial',-encoding => 'latin1');
my $txt = $page->text;
}
$txt->font($fnt, 10);
$txt->translate(100,$line);
$txt->text("$i This is the first line");
$line=$line-15;
$i++;
}
$txt->textend;
$pdf->save;
$pdf->end( );
The problem is that you are making new page, but forget new variables instantly:
if(($i%50) == 0)
{
my $page = $pdf->page;
my $fnt = $pdf->corefont('Arial',-encoding => 'latin1');
my $txt = $page->text;
}
All my variables you make disappear on closing parentheses. Just remove my and you will modify variables from top-level scope.
Edit: You also probably want to reset $line variable when making new page.
The typeface, $fnt, does not have to be changed since it depends on the PDF, $pdf, and not the page, $page.
As much as I love Perl, I learned enough Python to use the ReportLabs library for PDF generation. Creating PDF is one of the weak spots of Perl v. Python.