git clone git@github.com:ingydotnet/inline-c-pm inline-c-pm
[download]

Apologies if this seem like a simple question, I'm working on learning the more advanced topics in perl.

I'm having trouble pulling information out of data an array reference. I'm trying to print data that returned from the aliases method. Would anyone be able to tell me what I'm doing wrong?

#:Code

#!/usr/bin/perl
#
use strict ;
#use lib "/var/www/html/monkey/cgi-bin";
use lib "/var/www/html/production/cgi-bin";

# load the WebUI common libraries
use Infoblox::WebUI ;
use Data::Dumper;


 my $session = Infoblox::Session->new(
     master   => $address,
     username => $user,
     password => $passwd,
     timeout  => $timeout_num,
     connection_timeout => $conn_timeout
      );

print "Check:".Infoblox::status_code() . ":" . Infoblox::status_detail
+()."\n";

unless ($session) {
                   die("Construct session failed: ",
                   Infoblox::status_code() . ":" . Infoblox::status_de
+tail());
}

 #Get DHCP Host Address object through the session
 my @retrieved_objs = $session->get(
     object => "Infoblox::DNS::Host",
     name => "testone.cnti.com",
 );


#my @tmp_array = @$_->aliases() for (@retrieved_objs);
#print "aliases: " . @tmp_array;

print "aliases: " .$_->aliases(),"\n" for (@retrieved_objs);
print "dns_name: " . $_->dns_name(),"\n" for (@retrieved_objs);
print "ipv4addrs: " . $_->ipv4addrs(),"\n" for (@retrieved_objs);
print "comment: " . $_->comment(),"\n" for (@retrieved_objs);
print "name: " . $_->name(),"\n" for (@retrieved_objs);:
:
:
:OUTPUT
[user1@host perl]$ ./infoblox_test4.pl
Check:0:Operation succeeded
aliases: ARRAY(0x55f6da24f8f0)
dns_name: testone.cnti.com
ipv4addrs: ARRAY(0x55f6da243eb0)
comment: Standard Network: [TAGS: STATIC;cc.cnti.com]
name: testone.cnti.com
zone: cnti.com
ttl: 300
[download]

I have found the answers (I'm pretty sure, haven't fully tested yet) to 1 and 3. Number 2 is getting me a bit. I found the bookmarking ability of PDF::Reuse to be close, but I want to bookmark to a specific string, not a page number since I won't necessarily know the right page number since the PDF was just generated back in step one.

Is there a way to do the bookmarking thing but to a specific string (which I can preset when building the HTML)?

hello all

i have the problem that i am not able to get a simple perl script doing a database connection and query. here the error i get:

install_driver(ODBC) failed: Can't locate DBD/ODBC.pm in @INC (you may need to install the DBD::ODBC module) (@INC contains: /Library/Perl/5.18/darwin-thread-multi-2level /Library/Perl/5.18 /Network/Library/Perl/5.18/darwin-thread-multi-2level /Network/Library/Perl/5.18 /Library/Perl/Updates/5.18.2/darwin-thread-multi-2level /Library/Perl/Updates/5.18.2 /System/Library/Perl/5.18/darwin-thread-multi-2level /System/Library/Perl/5.18 /System/Library/Perl/Extras/5.18/darwin-thread-multi-2level /System/Library/Perl/Extras/5.18 .) at (eval 4) line 3. Perhaps the DBD::ODBC perl module hasn't been fully installed, or perhaps the capitalisation of 'ODBC' isn't right. Available drivers: DBM, ExampleP, File, Gofer, Proxy, SQLite, Sponge. at testperldb.pl line 10.

i am running mac os mojave 10.14.2

the db connection works using "Azure Data Studio"

any help is deeply appreciated

I've a script which works fine on FC20. But, when I try to execute the same script on CentOS(CentOS Linux release 7.5.1804 (Core)), it hangs. On further, investigation it was revealed that, it is not able to match the prompt given. Please note it is able to match host prompt but not application prompt. Here is a brief detail of the issue

Code of the wrapper function which is used to create object of Net::Telnet-

package api::Telnet;

use strict;
use warnings;
use Net::Telnet;
use Exporter;
use Carp;

our @ISA    = qw (Exporter);
our @EXPORT = qw (
    &open_pty
    &close_pty
);

# Constant global variables
use constant SSH_TIMEOUT => 1800;

sub spwan_pty 
{
    my (@cmd) = @_;
    my ($pid, $tty, $tty_fd);

    # Create a new pseudo terminal
    use IO::Pty ();
    my $pty = new IO::Pty or die $!;

    # Execute the program in another process
    # Child process
    unless ($pid = fork) {
        die "problem spawning program: $!\n" unless defined $pid;

        # Disassociate process from existing controlling terminal
        use POSIX ();
        POSIX::setsid
            or die "setsid failed: $!";

        # Associate process with new controlling terminal
        $pty->make_slave_controlling_terminal;
        $pty->set_raw();
        $tty = $pty->slave();
        $tty_fd = $tty->fileno;
        close $pty;

        # Make stdio use the new controlling terminal
        open STDIN, "<&$tty_fd" or die $!;
        open STDOUT, ">&$tty_fd" or die $!;
        open STDERR, ">&STDOUT" or die $!;
        close $tty;

        exec @cmd
            or die "problem executing $cmd[0]\n";
    } # end child process  

    $pty;
}

sub open_pty 
{
    my (%args) = @_;

    # Start ssh program.
    my $pty = &spwan_pty("ssh",
        "-l", $args{user_name},
        "-e", "none",
        "-F", "/dev/null",
        "-o", "PreferredAuthentications=password",
        "-o", "NumberOfPasswordPrompts=1",
        "-o", "StrictHostKeyChecking=no",
        "-o", "UserKnownHostsFile=/dev/null",
        $args{ip_addr}
    );

    # Create a Net::Telnet object to perform I/0 on ssh's tty
    my $ssh = new Net::Telnet (
        -fhopen          => $pty,
        -prompt          => $args{prompt},
        -telnetmode      => 0,
        -cmd_remove_mode => 1,
        -timeout         => SSH_TIMEOUT,
        -output_record_separator => "\r",
        #-errmode         => sub { print "Telnet FAIL\n"; }
    );

    # Wait for the password prompt and send password.
    $ssh->waitfor(-match => '/password: ?$/i', -errmode => "return")
        or die "problem connecting to \"$args{ip_addr}\": ", $ssh->las
+tline;

    $ssh->print($args{user_pswd});

    # Wait for the shell prompt.
    my (undef, $match) = $ssh->waitfor(
        -match => $ssh->prompt,
        -match => '/^Permission denied/m',
        -errmode => "return"
    ) or return $ssh->error("login failed: expected shell prompt ", "d
+oesn't match actual\n");

    return $ssh->error("login failed: bad login-name or password\n") i
+f $match =~ /^Permission denied/m;

    # logging 
    $ssh->input_log($args{log_file});
    $ssh->cmd("ifconfig");
    $ssh->cmd("date");
    return $ssh;
}

sub close_pty
{
    my ($tty) = shift;
    $tty->close();
}

1;
[download]

Once Net:Telnet object is obtained, it is used to spawn an interactive application. Here is the code snippet of the same-

 
my $host_prompt = '/[\$%#>] $/';
my $util_prompt = '/(\s)*Command: (\s)*/i';

my $owner = &open_pty (
                user_name     =>  "<user_name>",
                user_pswd     =>  "<password>",
                 ip_addr       =>  "127.0.0.1",
                prompt        =>  $host_prompt,
                log_file      =>  'Log/Owner'
            );

$owner->cmd ( String => "cd <navigate to application path>", Prompt =>
+ $host_prompt );
$owner->cmd ( String => "<Launch the application>", Prompt => $util_pr
+ompt );
$owner->cmd ( String => "<Execute command>", Prompt => $util_prompt );
[download]

The code successfully creates a Net::Telnet object and spawn the application, but it is unable to match the prompt of the application, due to which it hungs and the script is unable to proceed forward. Here is the log generated-

em1: flags=4163<UP,BROADCAST,RUNNING,MULTICAST>  mtu 1500
        inet xxx.xxx.xxx.xxx  netmask 255.255.252.0  broadcast xxx.xxx
+.xxx.xxx
        inet6 xxxx::xxxx:xxxx:xxxx:xxxx  prefixlen 64  scopeid 0x20<li
+nk>
        ether xx:xx:xx:xx:xx:xx  txqueuelen 1000  (Ethernet)
        RX packets 393842  bytes 40650026 (38.7 MiB)
        RX errors 0  dropped 0  overruns 0  frame 0
        TX packets 138388  bytes 15595013 (14.8 MiB)
        TX errors 0  dropped 0 overruns 0  carrier 0  collisions 0
        device interrupt 16  memory 0x92f00000-92f20000  

lo: flags=73<UP,LOOPBACK,RUNNING>  mtu 65536
        inet 127.0.0.1  netmask 255.0.0.0
        inet6 ::1  prefixlen 128  scopeid 0x10<host>
        loop  txqueuelen 1000  (Local Loopback)
        RX packets 5296  bytes 928222 (906.4 KiB)
        RX errors 0  dropped 0  overruns 0  frame 0
        TX packets 5296  bytes 928222 (906.4 KiB)
        TX errors 0  dropped 0 overruns 0  carrier 0  collisions 0

virbr0: flags=4099<UP,BROADCAST,MULTICAST>  mtu 1500
        inet xxx.xxx.xxx.xxx  netmask xxx.xxx.xxx.xxx  broadcast xxx.x
+xx.xxx.xxx
        ether xx:xx:xx:xx:xx:xx  txqueuelen 1000  (Ethernet)
        RX packets 0  bytes 0 (0.0 B)
        RX errors 0  dropped 0  overruns 0  frame 0
        TX packets 0  bytes 0 (0.0 B)
        TX errors 0  dropped 0 overruns 0  carrier 0  collisions 0

[root@hyd1658 ~]# Wed Jan 16 15:29:54 IST 2019
.
.
.
.


        Command:
[download]

Please Note: The same code works on FC20, but fails on CentOS

Could anyone please pinpoint the issue or suggest a remedy for the same

Hello, I have a file that has a hash stored in it. I am trying to read that hash as it is using eval but I am getting following error: Global symbol "%hash1" requires explicit package name (did you forget to declare "my %hash1"?) at tiny.pl line (print Dumper(\%hash1);) 14. Execution of tiny.pl aborted due to compilation errors. Please help me understand the issue here, thank you

 
#file.pl : my %hash1 = (hello => 1,
          hi =>2   );

#tiny.pl
#!/home/utils/perl5/perlbrew/perls/5.24.2-021/bin/perl

use strict;
use warnings;
use Path::Tiny qw( path );
use Data::Dumper; 
 
my $file = 'file.pl';

open(my $fh, '<', $file) or die "Could not open file $file";
eval($fh);
close $fh;

print Dumper(\%hash1);
[download]

#!/usr/bin/env perl
use 5.010;
use warnings;
use strict;

my $var1 = "abel";
my $var2 = "baker";
my $var3 = "charlie";

while (my $line = <DATA>) {
    chomp $line;
    say "Before interpolation: $line";
    say "After interpolation:  " . perform_interpolation($line);
    say '';
}

sub perform_interpolation {
    my $text = shift;
    # now what?
}

__DATA__
I'd like to see this one: $var1.
How about \$var3? You shouldn't interpolate \$var3 (but it would be ni
+ce if you'd remove the backslash)
Try a concatenation: $var1$var2
[download]

What I'm trying to do is create a program template where a comment block right after the shebang line (possibly containing scalar variables like $program or other constants or environment variables) can be rendered to produce a usage statement.

The perform_interpolation() subroutine would be part of the template and wouldn't know specifically what variables the programmer might want to interpolate for the usage statement.

Can String::Interpolate do this? Or is there a simpler way?

How can i Compare multiple strings in faster way

$name = "john";
$t1   = "john";
$t2   = "john";

if ($name ne $t1 || $t2) {
do something
}
[download]

Hi Expert, I am using the PERL language with the PostgreSQL database and in a couple of database function, we are using the plperl as language. We are basically calling the SOAP API in the function, however yesterday we faced the issue where PARL had sent the SIGALRM signal and my database got crashed. Can you please review and help me to resolve the issue, either by a code change or a configuration change.

CREATE OR REPLACE FUNCTION sendclaimcoversheet(
    text,
    text)
  RETURNS integer AS
$BODY$

    use strict;
    use warnings;
    use SOAP::Lite;
    use Try::Tiny;
    use Time::Piece;

    my $first = $_[0];
    my $second = $_[1];
    try
    {
        my $host = `hostname`; 
        my $rv = spi_exec_query("select * from getsprocurl('sendclaimc
+oversheet','".$host."')");
        my $url = $rv->{rows}[0]->{ret_url};
        elog(NOTICE, 'Host Name  ' . $host . ' URL '. $url );
        my $soap = SOAP::Lite->new();
        my $service = $soap->service($url);
        my  $response = $service->sendClaimCoversheet($first, $second 
+);
        return $response;
    }
    catch
    {
        my $ex = $_;
        return 'SOAPFAULT: ' . localtime->strftime('%m/%d/%Y') . ' ' .
+ $ex;
    } 
    $BODY$
  LANGUAGE plperlu VOLATILE STRICT
  COST 100;
ALTER FUNCTION sendclaimcoversheet(text, text)
  OWNER TO postgres;
[download]