I am new to perl. I am asked to execute a macro in ms access database using perl. This is the code i used
$oAccess = Win32::OLE->GetActiveObject('Access.Application');
$oAccess ->OpenCurrentDatabase($path);
$oAccess ->{DoCmd}->RunMacro("DO ALL");
Today when i was executing the program i found that only if the access database is open the code works fine else it returns the following error
Can't call method "OpenCurrentDatabase" on an undefined value at auto.pl line 30
So I was wondering if i could find any other code which would serve the purpose without an open ms access database.
my $MSAccess;
eval {$MSAccess = Win32::OLE->GetActiveObject('Access.Application')};
die "Access not installed" if $#;
unless (defined $MSAccess) {
$MSAccess = Win32::OLE->new('Access.Application','Quit')
or die "Unable to start Access";
}
$MSAccess->{visible} = 0;
Related
I have a website using a perl script for customers to upload a pdf file for me to print and post the printed pages to them.
I am using PDF::API2 to detect the page size and number of pages in order to calculate the printing costs.
However, if the pdf file is password protected this does not work and I get this error -
Software error:
Objind 9 does not exist at index 0 at /home5/smckayws/public_html/hookincrochet.com/lib//PDF/API2/Basic/PDF/File.pm line 758.
I am trying to use the isEncrypted feature in the pdf::api2 module to catch that the file is encrypted in order to direct the customer to a different page so they can enter the page size and page number manually, but it is not working for me.
I just get the same error message as above.
I have tried the following code snippets found elsewhere.
my $pdf = PDF::API2->open( "$customer_directory/$filename" );
if ( defined $pdf && $pdf->isEncrypted )
{
print "$pdf is encrypted.\n";
exit;
}
while (glob "*.pdf") {
$pdf = PDF::API2->open($_);
print "$_ is encrypted.\n" if $pdf->isEncrypted();
}
Any help would be greatly appreciated.
My guess is that the PDFs might use a feature that your version of PDF::API2 doesn't support. This is a workaround for the problem.
Wrap the call to isEncrypted in an eval, catch the error and handle it.
This will only work if the error does not occur on unencrypted files.
my $pdf = PDF::API2->open( "$customer_directory/$filename" );
if ( defined $pdf ) {
eval { $pdf->isEncrypted };
if ($#) {
# there was some kind of error opening the file
# could abort now, or look more specific, like this:
if ($# =~ m/Objind 9 does not exist at index 0/) {
print "$pdf is encrypted.\n";
exit;
}
}
# file is not encrypted, opening worked, continue reading it
}
I'm using Apache2.2(worker)/mod_perl 2.0.4/Apache::DBI/CGI::Session and Firebird RDBMS.
I also wrote CGI::Session::Driver::firebird.pm to work with Firebird RDBMS.
DB connection is pooled by Apache::DBI and give connection handle to CGI::Session {Handle=>$dbh}.
Number of DB connection is equals to number of worker processes.
I posted Programming with Apache::DBI and firebird. Get Stucked httpd on exception 3 month ago.
I found a reason of that issue, and want to know how to fix it.
$dbh = DBI->connect("dbi:Firebird:db=$DBSERVER:/home/cdbs/xxnet.fdb;
ib_charset=UTF8;ib_dialect=3",$DBUSER,$DBPASS,{
AutoCommit=>1,
LongReadLen=>8192,
RaiseError=>1
});
my $session = new CGI::Session('dbi:firebird',$sessid,{Handle=>$dbh});
my $ses_p1 = $session->param('p1');
eval { $dbh->begin_work()
my $sql = "SELECT * FROM SAMPLETABLE"
my $st = $dbh->prepare($sql);
$st->execute();
while (my $R = $st->fetchrow_hashref()) {
...
}
$st->finish();
}; warn $# if $#;
if ($#) {
$dbh->rollback();
}else{
$dbh->commit();
}
$session->flush();
When an sql error is occured, an eval block catches exception and rollback transaction.
After that, CGI::Session does not retrieve session object no more.
Because prepare_cached statement failes at CGI::Session::DBI.pm.
CGI::Session::DBI.pm use prepare_cached($sql,undef,3). '3' is safest way of using cached statement, but it never find broken statement at this situation.
How to fix this ?
raise request to change CGI::Session::DBI.pm to use prepare() statement ?
write store(),retrieve(),traverse() function in firebird.pm to use prepare() statement ?
It may other prepare_cached() going to fail after catch exception...
1) I add die statement on CGI::Session->errstr()
I got an error "new(): failed: load(): couldn't retrieve data: retrieve(): $sth->execute failed with error message"
2) I flush session object after session->load()
if $session is valid, changes are stored to DB.
3) I replace begin_work() to {AutoCommit}=0
results are same. I can use $dbh normally after catching exception and rollback, BUT new CGI::Session returns error.
------------------------------------------ added 2017/07/26 18:47 JST
Please give me your suggestion.
Thank you.
There are various things you could try before request changes to CGI::Session::Driver::DBI.pm ...
First, change the way new CGI::Session is called in order to diagnose if the problem happens when the session is created or loaded:
my $session = CGI::Session->new('dbi:firebird',$sessid,{Handle=>$dbh}) or die CGI::Session->errstr();
The methods param or delete stores changes to the session inside $session handle, not in DB. flush stores in DB the changes made inside the session handle. Use $session->flush() only after a session->param set/update or a session delete:
$session->param('p1','someParamValue');
$session->flush() or die 'Unable to update session storage!';
# OR
$session->delete();
$session->flush() or die 'Unable to update session storage!';
The method flush does not destroy $session handle (you still can call $session->param('p1') after the flush). In some cases mod_perl caches $session causing problems to the next attempt to load that same session. In those cases it needs to be destroyed when it's not needed anymore:
undef($session)
The last thing i can suggest is avoid using begin_work method, control the transaction behavior with AutoCommit instead (because the DBD::Firebird documentation says that's the way transactions should be controlled) and commit inside the eval block:
eval {
# Setting AutoCommit to 0 enables transaction behavior
$dbh->{AutoCommit} = 0;
my $sql = "SELECT * FROM SAMPLETABLE"
my $st = $dbh->prepare($sql);
$st->execute();
while (my $R = $st->fetchrow_hashref()) {
...
}
$st->finish();
$dbh->commit();
};
if ($#) {
warn "Tansaction aborted! $#";
$dbh->rollback();
}
# Remember to set AutoCommit to 1 after the eval
$dbh->{AutoCommit} = 1;
You said you wrote your own session driver for Firebird... You should see how the CGI/Driver/sqlite.pm or CGI/Driver/mysql.pm are made, maybe you need to write some fetching method you are missing...
Hope this helps!!
I am connecting to sybase 12 from a perl script and calling storedprocs, I get the following warnings
DBD::Sybase::db prepare failed: Server message number=2401 severity=11 state=2 line=0 server=SERVER_NAME text=Character
set conversion is not available between client character set 'utf8' and server character set 'iso_1'.
Server message number=2411 severity=10 state=1 line=0 server=SERVER_NAME text=No conversions will be done.
at line 210.
Now, I understand these are only warnings, and my process works perfectly fine, but I am calling my stored proc in a loop and throughout the day and hence it creates a lot of warning message in my log files which causes the entire process to run a bit slower than expected. Can someone help me how can i suppress these please?
You can use a callback to handle the messages you want ignored. See the DBD::Sybase docs. The below is derived from the docs. You specify the message numbers you would like to ignore.
%blocked_msgs = map { $_ => 1 } ( 2401, 2411 );
sub err_handler {
my($err, $sev, $state, $line, $server, $proc, $msg, $sql, $err_type) = #_;
if ( exists $blocked_msgs{$err} ) { # it's a blocked message
return 0; # This is not an error
}
return 1;
}
This is how you might use it:
$dbh = DBI->connect('dbi:Sybase:server=troll', 'sa', '');
$dbh->{syb_err_handler} = \&err_handler;
$dbh->do("exec someproc");
$dbh->disconnect;
I'm writing a software testing framework using perl on Windows platform, which run test cases by calling the software under test. If a test case fails, the framework will capture the screen so we could get more information about the failure.
At first I used an small program called boxcutter-fs.exe. So all I need is to call this program when test case fails:
system("boxcutter-fs.exe screenshot.png");
print "Failed: $?" if ($?);
When the framework handles a normal failure, it works great and give me the right failure screenshot. But I noticed that when the software crashed (an error message box would occur on the active window, and the software under test will be killed after a timeout), boxcutter-fs.exe exited with code 1, and didn't get any screenshot.
Then I turned to other solutions. The first alternative that I tried is Win32::GuiTest:
eval {
SendKeys('{PRTSCR}');
my $screen = Win32::Clipboard::GetBitmap() or die "No image captured: $!\n";
open BITMAP, "> screenshot.bmp" or die "Couldn't open bitmap file: $!\n";
binmode BITMAP;
print BITMAP $screen;
close BITMAP;
};
print "$#" if ($#);
The same result. This works well unless the software crash case occurred. The program reported No image captured so I think Win32::Clipboard::GetBitmap didn't get any thing in the Clipboard.
The last solution is Imager::Screenshot:
eval {
my $img = screenshot(hwnd => 'active');
$img->write(file => 'screenshot.bmp', type => 'bmp' )
or die "Failed: ", $img->{ERRSTR} , "\n";
};
print "$#" if ($#);
This time it gave a black screen screenshot (an all-black image) when the software crash case occurs. Still doesn't work.
Then I found that when the crash and error message box occurs, but the software hasn't been killed so the test framework is still hanging, using a small script with any of the solutions above could capture the screenshot. It seems they just fail at the moment when the software under test is being killed.
Since these 3 methods all use Win32 API to get the screenshot, I wonder they might fail due to the same issue? Any hints?
I studied the source code of Imager::Screenshot, and found the possible cause for the screenshot failure.
First of all, if I use -d option of perl to debug the screenshot script, when the software under test crashed and was killed after a timeout, the screenshot worked. So I suppose the screenshot failure should be a corner case in a specific situation.
Then I read the source code of Imager::Screenshot. Basically, it's a perl module calling XS extensions written with Win32 APIs. The processing flow is basically as following:
Use GetDC according to the window handler hwnd to get display device context dc
Use CreateCompatibleDC to get the device context handler hdc
Use GetDIBits to retrieve the bits of the device context, and write them to the bmp file
My problem is that when the software under test crashed and was killed, the hwnd of its window would be invalid at once, but it was still passed to GetDC to get the display device context, thus the result was invalid too (the bmp file was memset to all 0 at the beginning, so it's a black screenshot)
Now that I noticed the root cause was the invalid hwnd, I come up with a work around: take the screenshot before killing the software under test. I used Proc::Background and Win32::GuiTest. The key point is to ensure the software GUI is set as foreground window:
sub captureWindow {
my ($pid, $screenshot_name) = #_;
for my $hwnd (&findHwnd($pid)) {
if (Win32::GuiTest::SetActiveWindow($hwnd) && Win32::GuiTest::SetForegroundWindow($hwnd)) {
system("boxcutter-fs.exe $screenshot_name");
# send ALT+TAB key so the script was set back to foreground window
Win32::GuiTest::SendKeys("%{TAB}");
last;
}
}
}
sub findHwnd {
my ($target_pid) = #_;
my #target_hwnd;
EnumWindows(
Win32::API::Callback->new(sub {
my ($hwnd, $target_pid) = #_;
my $pid = 0xffffffff;
my $tid = GetWindowThreadProcessId($hwnd, $pid);
$pid = unpack 'L', $pid;
if ($target_pid == $pid) {
push #target_hwnd, $hwnd;
}
return 1;
}, 'NN', 'I'),
$target_pid,
);
return #target_hwnd;
}
sub monitorTestProcess {
my ($cmd, $timeout) = #_;
my $rs;
my $proc = Proc::Background->new($cmd);
my $pid = $proc->pid;
select(undef, undef, undef, 0.5);
&captureWindow($pid, "screenshot_begin.png");
my $timeCount = 0;
while ($proc->alive) {
if ($timeCount >= $timeout) {
&captureWindow($pid, "screenshot_timeout.png");
$proc->die;
last;
}
select(undef, undef, undef, 1);
$timeCount++;
}
return $rs;
}
I am able to open Lotus notes api using Perl, without errors, also I can get list of views that includes Inbox, but when I try to read messages from that view it appears empty? What might I be doing wrong? (in fact it seems like something might of changed on notes side as this code used to work before)
Result of code below:
NAME of View is: ($Inbox) has count of: 0
etc.
CODE:
use Win32::OLE;
my $Notes = Win32::OLE->new('Notes.NotesSession')
or die "Cannot start Lotus Notes Session object.\n";
my $database = $Notes->GetDatabase("",'mail\VIMM.nsf');
$database->OpenMail;
my $array_ref = $database->{Views};
foreach my $view (#$array_ref) {
my $name = $view->{Name};
print "NAME of View is: $name ";
$view = $database->GetView($name);
print "has count of: ", $view->{entryCount}, "\n";
}
Is the mailbox open to all users? You could try setting the -Default- access to Manager and grant it all available roles, just to make sure it's not a security issue preventing the documents from being seen.
I believe it is spelled "EntryCount"?
Also, I recommend "use strict" and "use warnings".
Per runrig's comment, EntryCount is an attribute, so I believe you need:
$view->{entryCount}
Try checking Win32::OLE::LastError() messages. You can do this explicitly with a sub like:
sub w32_ok {
if (my $error = Win32::OLE::LastError()) {
print "Win32::OLE Error! Got: $error";
}
}
Or, have it croak errors, like:
Win32::OLE->Option( Warn => 3 ); # will now croak on errors.
It may be having problems accessing the data you want.