Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x

Perl

26K

Solutions

10K

Contributors

Perl is a high-level, general-purpose, interpreted, dynamic programming languages with over 25 years of development. Perl 5 runs on over 100 platforms from portables to mainframes and is suitable for both rapid prototyping and large-scale development projects.  Perl gained widespread popularity as a Common Gateway Interface (CGI) scripting language, in part due to its regular expression and string parsing abilities. In addition to CGI, Perl is used for graphics programming, system administration, network programming, finance, bioinformatics, and other applications.

Share tech news, updates, or what's on your mind.

Sign up to Post

Hi

Given the code and html snippet bellow I'm trying to extract the name from the img alt tag

I can isolate the alt tag but can't get just the  name!

I want $name = "trevor OBT tumblr_ozxualLdb1who6_540.jpg"

As this is html I've no idea if each line of the alt ends in "\n" and my split isn't working

use strict; use warnings;
use HTML::TreeBuilder;
use HTML::Element;


my $body =HTML::TreeBuilder->new_from_file(*DATA);
  my @A = $body -> look_down('_tag', 'a');
  for my $a (@A){
    my $url = $a->attr('href'); 
    if((defined($url)) && ($url=~m/attachment/)  ){
        print  $url ."\n";
        my $img = $a -> look_down('_tag', 'img');
        my $alt = $img->attr('alt'); 
        print "alt [" . $alt . "]\n";  ##  works to here
        my @altBits = split(/nbsp/,$alt);
        foreach my $line (@altBits){
            if ($line =~ m/Name:\s.*(.*)\&/i){
                my $name =$1;
                print "name [$name]\n";                
                }
            }

         
        }
     else   {
                    print $url ."\n";
        }
    }# end for $A
print "Finished \n";

__DATA__
<div class="postbody">
			<div class="postrow">
				<div class="content">
					<div id="post_message_180">
						<blockquote class="postcontent restore ">
							Trevor <br>
<a href="http://www.example.com/vboard/attachment.php?s=b31c60a8e6f7c723&amp;attachmentid=104&amp;d=623527" 
id="attachment1040762" rel="Lightbox_1804154">
<img 

Open in new window

0
Free Tool: Site Down Detector
LVL 11
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

When I write a program in Perl 6, is it visible to the user, like JavaScript? Or is it compiled into an interim format that is not accessible to the user?

I am considering using Perl for a public facing web page but also for downloadable tool they would run locally.

I hear there is a bin folder, but what exactly goes into this? Is it the .pl file?

Thanks
1
I have version 5 currently...

My-MBP-2:~ newbieweb$ perl -v

This is perl 5, version 18, subversion 2 (v5.18.2) built for darwin-thread-multi-2level
(with 2 registered patches, see perl -V for more detail)

Copyright 1987-2013, Larry Wall

and I run El Capitan

I need to instal Perl 6 but be sure in no way that it impacts the current installation of Perl 5, which is used by my system.

Thanks.
0
I am new to the Perl syntax but have used OOP from Pascal, to C++ to C#.

Can you give me an example of the syntax for using OOP in Perl?

Thanks.
0
I understand Perl is part of my Mac OS, but I hear I would be best served to ensure any programming (learning) in Perl should be isolated so as not to upset the functioning of my El Capitan system.

What kind of installation shall I make to ensure the Perl I access from Mac Terminal does not touch any system files?

Thanks.
0
Years ago, I learned Sed and Awk to complete a project in telecom. Today, I do not recall any aspect of those languages. But am about to learn Perl and have been told that Perl is based on Sed and Awk.

Is that true?

And how are they similar?

Once I start hearing these details, I suspect I will recall a few things about how and why I used Sed and Awk.

Thanks.
0
I have no experience with Perl and suspect it may be the best choice of technology for a financial analysis and reporting website I am making. I expect to allow users to upload PDF's or CSV files to my website, which my site will then parse, summarize and generate new reports.

There will be times when my logic needs to access published national standards tables for a specific record with names like:

CPS Retail 2 Max (Developing Markets only)
CPS Retail Key Entered

from a list of thousands of items

So, this is the reason I suspect Perl is a good choice.

Can someone please confirm that and show me why Perl is so good for pattern matching?

Is it a front end or a back end technology? What other technologies often work well with Perl? It is compiled? Or is it a script?



Thanks.
0
Hi

From the Image-Grab page on cpan

  use Image::Grab;
  my $url ='http://www.example.com/FileName.html'
                      my $pic = Image::Grab->new(SEARCH_URL=>$url,
                                    REGEXP    =>'.*\.jpg');
                  $pic->grab;
                  my $File = basename($url);
                      $File =~ s/html/jpg/i;
                    # Now to save the image to disk
                    open(IMAGE, ">$File") || die"$File: $!";
                    binmode IMAGE;  # for MSDOS derivations.
                    print IMAGE $pic->image;
                    close IMAGE;

Open in new window


I'm getting the error "Couldn't determine an absolute URL!" because the html page I'm searching uses upper case 'JPG' so the regex fails

How do I make the REGEX non case sensitive?

Also can you determine the File name of the image from the REGEX?
" my $File = $pic->name;" causes another error
Can't access `name' field in class Image::Grab
0
I have the script to extract rows and output to a csv file. But, the file is appending each row to resulting in a concatenated output.
I want to output each row to a single line (see present and expected output below)

use strict;
use warnings;
use DBI;
use Date::Manip;
use Getopt::Std;

Date_Init('TZ=US/Central','Internal=1');

$| = 1;

my %opts;
getopts('d', \%opts);

my $date    = UnixDate(($opts{'d'} || 'today'), '%q');
my $nodata = 0;
my ($db, $user, $pw, $wkdir, $firstday, $lastday)  = @ARGV;

#Check to see if required parameters are received by appworx

unless($db && $user && $pw && $wkdir && $firstday && $lastday) 
{
	print("args = $date, $db, $user, $pw, $wkdir, $firstday, $lastday\n\n");
    die("\n\n  - ERROR:  The Required number of arguments were not received.  Verify that the AppWorx prompts are correct and reset the module..\n\n");
} 

# Display parameter values passed by the appworx

print("\n");
print("Database Instance  : $db \n\n");
print("Connected as User  :	$user \n\n");
print("Output Directory is : $wkdir \n\n");

# Connectivity check to the database else display failed connectivity

my $dbh = DBI->connect("dbi:Oracle:$db", $user, $pw) or die("Cannot connect to Database '$db' " . DBI->errstr());

# Capture counts for distinct partitions for given firstday and lastday dates
my $sthcounts = $dbh->prepare(qq(select /*+ full(r) parallel(r,4) */ count(distinct r.partition_key) from region r where r.status = 'N' and r.firstday = 

Open in new window

0
I am trying to reference the value of query in a subsequent query and get an error "not an array reference "on line 11.

I am extracting the partkey and assigning it to dataextract. I would like to use this value of partkey in subsequent prepare statement in the script.  I am not sure why the assignment fails.

my $dataextract = $dbh -> prepare(qq(select distinct partkey from table_A where firstvar = ? and secvar2 = ?)))
												 or die("Could not get data from $_ ".DBI->errstr);											 
 
$dataextract -> bind_param(1,$firstvar);
$dataextract -> bind_param(2,$secvar);
$dataextract -> execute();
												 
if ($dataextract) 
 {
	my $genextract = $dbh->prepare(qq(SELECT COL1, COL2, COL3  FROM table_A WHERE partkey = @$dataextract))	-- line 11															
                 or die("Could not get data from $_ ".DBI->errstr);
   ..
  ..
  ..                								
  } 
 else
   exit(1);

Open in new window

0
Industry Leaders: We Want Your Opinion!
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

This is my program

Example.html
<html>
<body>
<form action="/cgi-bin/time.pl">
<input type="submit"/>
</form>
</body>
</html>
And my perl script "time.pl"
#!/usr/bin/perl
print "content-type:text/plain\n";
use CGI': standard';
($sec,$min,$hr)=localtime(time);
print "$hr:$min:$sec";

Open in new window


If i run example.html in server it shows file not found
0
I am executing my script on the command line with parameter ('?')  values for $firstday and $lastday.  I am passing values sysdate-60 and sysdate for these 2 values of '?'  These values are called from a oracle database function of a DATE datatype.  But the script is failing with on a non-numeric character found on  '?'.   When I run the SELECT query by itself on the database, it works and returns rows.

Is the way I have written the prepare statement in call a database function date parameter,  the issue?

My prepare and bind/execute statements are:

my ($db, $user, $pw, $wkdir, $firstday, $lastday)  = @ARGV;
..
...
...
my $gen_text = $dbh->prepare(qq(SELECT col1, col2, col3  FROM region WHERE status = 'Y' and partition_key = (Select common.get_region('REGION',?, ?) from dual)))
                  								or die("Could not get data from table '$_'".DBI->errstr);

  ...            						
 $gen_text->bind_param(1,$firstday);
 ....
 $gen_text->bind_param(2,$lastday);
 ..
 $gen_text->execute();

Open in new window

0
Hi,

we are using Perl Template Toolkit and have a value of [% action %].

I want to now test this in an IF/ELSIF loop within a template but am struggling as I am simple.

My loop would look like:

[% IF action == i %]
The ACTION is I
[% ELSIF $myaction == u %]
The ACTION is I
[% END %]

But I can't work out how to test [% action %] within the IF loop.

thanks.
0
Hi,

I am modifying a perl script

Here is a section

sub forgotten_password		{
print header;
print start_html( -title => $title,  -style => { 'src' => "$web_path$style" }, -onload => "document.loginform.email.focus();" );

Open in new window


I need to get rid of formatting but keep the onload function. The following seems to work, however I would like to know of a way to put the onload command on it's own line.

sub forgotten_password		{
print header ( -onload => "document.loginform.email.focus();" );

Open in new window


thanks for you help.
0
The format of input file is ( two columns in excel):

A1;A2
A1:B3
A1:C3
A2:C3
A2:D1

I'd like to get (make) something like that:

A1=>[A2,B3,C3];
A2=>[C3,D1];

No Idea ho to do it ;(
0
I am using Perl to connect to Oracle database to retrieve rows.

The code fails with the error when attempting to assign bind parameters to 3 variables derivdate, group and row_number. The code works CORRECTLY and outputs data ONLY when the 3 values are hard coded in the query without the bind param assignments.


my $gen_text = $dbh->prepare(qq(SELECT col1, col2 FROM region WHERE STATUS = 'N' AND PARTITION_KEY IN (SELECT col_1 AS part_key FROM Sched  WHERE derivdate = to_date(?,'YYYY-MM-DD') and group = ? and row_number = ?)))    
               						or die("Could not get data from table '$_'".DBI->errstr); 
               						 
$gen_text->bind_param(1,$derivdate); 
$gen_text->bind_param(2,$group); 
$gen_text->bind_param(3,$row_number); 
 
$gen_text->execute($derivdate, $group, $row_number); 
 
 
my @firstrow; 
my @columns; 
 
 
if (exists($$cols[0])) { 
	   
        foreach my $col (@$cols) { 
            my ($name) = $$col[0]; 
            $name =~ s/\s+//g; 
            push @columns, $name; 
        } 
    } else { 
    	   
        my $rc  = $gen_text->fetchrow_hashref() or $nodata = 1; 
        if ($nodata) { 
        	print("  - No data found in table '$_' ".$gen_text->errstr());   -- Line 86
        	exit(0); 
        } 
        my @row = @{$gen_text->{NAME}}; 
        @$cols  = @row; 
     
        foreach my $col (@$cols) { 
            my $name = $col; 
            $name =~ s/\s+//g; 
            my $data = $rc->{$name}; 
            push @firstrow, 

Open in new window

0
hi,
i wrote simple perl script and trying to run geting below error from


https://www.tutorialspoint.com/unix_terminal_online.php

sh-4.4$ vi hi.pl                                                                                                                                                                            
sh-4.4$ pwd                                                                                                                                                                                  
/home/cg/root                                                                                                                                                                                
sh-4.4$ /home/cg/root/hi.pl                                                                                                                                                                  
sh: /home/cg/root/hi.pl: Permission denied                                                                                                                                                  

i just wrote in hi.pl as
print "hii";


in command prompt of windows it ran fine once i install activevperl
https://www.activestate.com/activeperl/downloads

C:\Users\ss\perl\code>perl hello.pl
hii

please advise
0
I am using Perl version 5.8.8 on Windows.

I have below incomplete perl script to read from a oracle 11g database table.

# This script connects to an oracle database, reads columns from region based on a selection criteria and output records in a csv 
# 
use strict;
use DBI;
use warnings;
use File::Copy;
use Text::CSV;

my $dbh = DBI->connect("dbi:Oracle:$db",$user,$pw)
              or die "Database connection not made: $DBI::errstr";
{
my $sth = $dbh->prepare("SELECT * FROM region");
$sth->execute;
my $names = $sth->{'NAME'};
my $tbl_data = $sth->fetchall_arrayref;
print join "\n", map { join(',', map { "\"$_\""' } @$_ } @$tbl_data;

$dbh->disconnect(); }

Open in new window


I am new to Perl and not sure how to achieve the following:

a. restrict the select statement with a where clause and use the below where clause condition as an input to the script.
b. update statement (as below) once the file is written to a csv.

 The select statement would be as below
select region_date, cntr_name  from region  
where cntr_name in ('US' , 'CAN')  
and flag = 'Y' and part_key =  
(select ('S_' || v.tsched || '_' || v.cgroup) as partition_key   
from rgvars v	 
WHERE v.regdate = -- "input parameter"														and v.cgroup = -- "input parameter" 
and v.dnumber = -- "input parameter ");
--
update region
set code = 'N' -- once the file is written out in a csv format

Open in new window


The desired output will be in a dump of the region table in a csv format with headers.


Thanks,
0
Hello,

I am trying to make modifications to a perl script in order to make it responsive to screen resolutions.

Here is an excerpt:

<tr>
<td colspan="2"></td>
<td colspan="2" style="color: #d00; text-align: left; font-weight: 700; line-height: 16px;"><!--ERROR--> </td>
</tr>			
<tr>				<td height="20" colspan="4"> </td>			</tr>
<tr>
<td colspan="2"></td>
<td colspan="4" style="text-align: left; padding-right: 0;"><font color="#c00000">*</font> Required fields</td>
</tr>			
<tr>				<td height="10" colspan="4"> </td>			</tr>
<!--NAME--><tr>
<!--NAME--><td class="txr"><!--FFN-->Name:</td>
<!--NAME--><td></td>
<!--NAME--><td class="txl"><input type="text" name="name" value=""><!--FN--> <font color="#c00000"><!--NAMER--></font></td>
<!--NAME--></tr>
<!--AGE--><tr>
<!--AGE--><td class="txr"><!--FAGE-->Age:</td>
<!--AGE-->	<td></td>
<!--AGE--><td class="txl"><input type="text" name="age" value=""><!--AGE--> <font color="#c00000"><!--AGER--></font></td>
<!--AGE--></tr>

Open in new window


I was under the impression that words enclosed in <!----> were simply comments. I found out that this wasn't the case, when I deleted <!--error-->, and the errors stopped showing up.

So therefore I assume that <!----> is for variables?

What could <!--NAME-->, <!--NAMER-->, <!--AGE-->, <!--AGER--> be doing? It doesn't seem to be making any difference at all when I remove them.

thanks for our help!
0
Concerto Cloud for Software Providers & ISVs
LVL 5
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

I am new to Perl (5.10.0) and creating a Perl script, connect to Oracle database (11.2.0.4) and output a csv file after reading columns from a table.

The below code selects data from an Oracle table inside a stored procedure/package.

Select all_cols  from
emp 
where emp_name = 'SMITH' and partition_key  = '20170101_20170331'

Open in new window



Here's my first time perl script that I put together. Not sure of what changes I need to make to the script to get my desired output in a csv format.

use strict;
use warnings;
use 5.27;

use DBI;
use Text::CSV;

my $dbi = DBI->connect( $dsn, $user, $pass );
Date_Init('TZ=US/Central','Internal=1');

my $sth = $dbi->prepare("SELECT columns from EMP table" );
$sth->execute;
WHILE (my $row = $sth->fetchrow_arrayref )
 {
    dump_table($row->[0] );
 }

sub dump_table 
  {
    my ( $table_name ) = 'Schema_name.table_name';

    print "Extracting $table_name...\n";

    my @column_names;
    my $column_name_sth = $dbi->prepare(
        "SELECT column_name FROM USER_TAB_COLUMNS"
        . "WHERE table_name = '$table_name' AND PARTITION_KEY = '20170101_20170331'"
    );
    $ column_name_sth->execute;
    while ( my $row = $column_name_sth-> fetchrow_arrayref ) {
        push @column_names, $row->[0];
    }

    my $csv = Text::CSV->new ( { binary => 1 } );
    $csv-> eol ("\n");

    Open ( my $fh, 
        ">: encoding(utf8)", 
        "$table_name.csv" 
    ) or die "$table_name.csv: $!”;

    $csv->print ($fh, \@column_names);

Open in new window

0
Hello,

I have a cgi perl script that mistakenly does not accept a user email address if there is a dot symbol anywhere before the @ sign.

here is the relevant line of code

$message .= 'Invalid address<br>' if $email !~ /^[A-Za-z0-9_]+@\w{1,63}\.[a-zA-Z]{2,6}(\.[a-zA-Z]{2,6}){0,2}$/;

Open in new window


Please tell me how to remove the dot restriction.
0
Hi I need to test meta data keys for valid
These Formats are valid

geo.0123.lowercaseword
AB.lowercaseword.lowercaseword
AB.lowercaseword.123
ABC.lowercaseword123
ABC.lowercaseword.lowercaseword
exception(s) or special cases where above rules don't apply

not valid
ab.UPPERcaseword123
AD.not132valid


so unless geo or exception
2 or 3 uppercase letters DOT lowercaseword DOT or numbers



for my $metaKey (sort keys $metaHash){
  next if($metaKey =~ m/(exceptions|list/);
  if($metaKey =~ m/^([A-Z]{2,3}\.[a-z0-9|\.]|geo\.\d.*[a-z])$/{
      print "$metaKey good\n";

  }
  else{
     print "$metaKey bad\n";

  }
}

Open in new window


I suspect I'll need to do this in 2 goes as the exceptions list might be quite long but if the $metaKey is not in this list or it's the wrong format it's bad

I'm assuming a hash key is case sensitive
so "HashKey" is not the same as "hashkey" and 1 doesn't overwrite the other?
0
Hello,
an xml file contains user records like:

<user>
<account_type>EXTERNAL</account_type>
<primary_id>BRMNTN62M16A944E</primary_id>
<first_name>John</first_name>
<last_name>Doe</last_name>

...other fields...

<user_identifier>
<id_type desc="Additional">02</id_type>
<value>john.doe@mymail.com</value>
</user_identifier>

...other fields...

</user>

Open in new window

it happens that some records have the SAME <primary_id> but the <value> of the <user_identifier> of <type> 02 (see above) have a value different than "<first_name>.<last_name>@mymail.com"
is it possible individuating & suppressing all and only these <user> records?
Thanks a lot,
Fabiano
0
I need a perl search string to validate filenames as I iterate through them.

The filenames should all:
Have 25 characters plus the extension (.xlsx), for example: TESTY_ClinicalQ_20171104.xlsx
First 5 characters: caps alphabetic
underscore
"ClinicalQ" just as it is (first character capital C, then lowercase "linical", then capital Q)
underscore
Then 8 numeric characters
.xlsx
0
Hi
I'm trying to extract elements from an XML file generated by mediainfo
I've done this before here but the format of the xml has changed

So how do I get at the file path on 'media ref' line and the other components
I'm getting "Not an ARRAY reference at"  line after dump
foreach my $file (@{$xml->{media}}) {

I tried to quote 'media ref' but didn't work

use strict;
use warnings;
use XML::Simple;
use Data::Dump qw(dump);

my $xml = XMLin('Path\\To\\Example.xml');

dump($xml);
foreach my $file (@{$xml->{media}}) {
    my ($FilePath,$NewName,$album,$movie);
    foreach my $key (qw(Complete_name CompleteName Collection Track Track_name Movie Movie_name Album Performer)) {
    print "key = $key\n";
        if (exists($file->{track}[0]{$key})){
            if(($key eq 'Complete_name') or ($key eq 'CompleteName')) {
                print 'File path = ', $file->{track}[0]{$key}, "\n";
                $FilePath = $file->{track}[0]{$key};
                }
            elsif(($key eq 'Collection') or ($key eq 'Album')){
                print 'Album = [', $file->{track}[0]{$key}, "]\n";
                $album = $file->{track}[0]{$key};
                }
            elsif($key =~ m/Track|Movie/i){
                print 'Movie = ', $file->{track}[0]{$key}, "\n";
                $movie = $file->{track}[0]{$key};
                }
            }
    }
  }  

Open in new window



Example.xml


Open in new window

0

Perl

26K

Solutions

10K

Contributors

Perl is a high-level, general-purpose, interpreted, dynamic programming languages with over 25 years of development. Perl 5 runs on over 100 platforms from portables to mainframes and is suitable for both rapid prototyping and large-scale development projects.  Perl gained widespread popularity as a Common Gateway Interface (CGI) scripting language, in part due to its regular expression and string parsing abilities. In addition to CGI, Perl is used for graphics programming, system administration, network programming, finance, bioinformatics, and other applications.