sub someFunction($$;$) {
my ( $oblig_param1, $oblig_param2, $option_param ) = @_;
...
}
; is optional before a @ or %, which, according to the docs, "gobbles up everything else".
File::stat (included as of Perl 5.004).stat($fh) returns an array with the following information about the file handle passed in (from the perlfunc man page for stat): 0 dev device number of filesystem
1 ino inode number
2 mode file mode (type and permissions)
3 nlink number of (hard) links to the file
4 uid numeric user ID of file's owner
5 gid numeric group ID of file's owner
6 rdev the device identifier (special files only)
7 size total size of file, in bytes
8 atime last access time since the epoch
9 mtime last modify time since the epoch
10 ctime inode change time (NOT creation time!) since the epoch
11 blksize preferred block size for file system I/O
12 blocks actual number of blocks allocated
my $epoch_timestamp = (stat($fh))[9];
my $timestamp = localtime($epoch_timestamp);
Time::localtime, another built-in module (also included as of Perl 5.004). This requires some (arguably) more legible code:use File::stat;
use Time::localtime;
my $timestamp = ctime(stat($fh)->mtime);
#! /usr/bin/perl -wT
use strict;
use DBI;
$ENV{PATH} = "/bin:/usr/bin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
# we assume that the name of your database is DATABASE, that the username
# to connect is UN and the password is PW. Here we also assume that your
# MySQL server is running on localhost (so your are connecting through
# the Unix socket file).
my $dbh = DBI->connect('DBI:mysql:DATABASE:localhost', 'USERNAME', 'PASSWORD')
or die "Cannot connect: " . $DBI::errstr;
# or:
my $dbh = DBI->connect('DBI:mysql:database=DATABASE;host=localhost','USERNAME','PASSWORD')
or die "Cannot connect: " . $DBI::errstr;
# select a single field:
my $sql = qq`SELECT field FROM table WHERE otherfield=1`;
my $sth = $dbh->prepare($sql) or die "Cannot prepare: " . $dbh->errstr();
$sth->execute() or die "Cannot execute: " . $sth->errstr();
my $field = $sth->fetchrow_array();
$sth->finish();
print "field is $field \n";
# select multiple fields:
$sql = qq`SELECT fielda,fieldb,fieldc FROM table WHERE otherfield=1`;
$sth = $dbh->prepare($sql) or die "Cannot prepare: " . $dbh->errstr();
$sth->execute() or die "Cannot execute: " . $sth->errstr();
my ($fielda,$fieldb,$fieldc) = $sth->fetchrow_array();
$sth->finish();
print "fielda is $fielda , fieldb is $fieldb , fieldc is $fieldc \n";
# select multiple fields with multiple rows:
$sql = qq`SELECT fielda,fieldb,fieldc FROM table`;
$sth = $dbh->prepare($sql) or die "Cannot prepare: " . $dbh->errstr();
$sth->execute() or die "Cannot execute: " . $sth->errstr();
my @row;
my @fields;
while(@row = $sth->fetchrow_array()) {
my @record = @row;
push(@fields, \@record);
}
$sth->finish();
# now process the fields
if (@fields != 0) {
my $i=0;
foreach $line (@fields) {
print "row $i - a is @$line[0] , b is @$line[1] , c is @$line[2] \n";
$i++;
}
}
# delete query
$sql = qq`DELETE FROM table WHERE field=1`;
$sth = $dbh->prepare($sql) or die "Cannot prepare: " . $dbh->errstr();
$sth->execute() or die "Cannot execute: " . $sth->errstr();
$sth->finish();
# update query
$sql = qq`UPDATE table SET field=1 WHERE otherfield=2`;
$sth = $dbh->prepare($sql) or die "Cannot prepare: " . $dbh->errstr();
$sth->execute() or die "Cannot execute: " . $sth->errstr();
$sth->finish();
# To increase your application security and prevent SQL injection attacks,
# it is advisable to use placeholders in queries (prepared statements):
$sql = qq`SELECT field FROM table WHERE name=? AND password=?`;
$sth = $dbh->prepare($sql) or die "Cannot prepare: " . $dbh->errstr();
$sth->execute($name, $password) or die "Cannot execute: " . $sth->errstr();
my $field = $sth->fetchrow_array();
$sth->finish();
| Numbers | Strings |
|---|---|
| < | lt |
| > | gt |
| <= | le |
| >= | gr |
| == | eq |
| <=> | cmp |
| Relation of $a and $b | Value Returned by $a <=> |
| $a greater than $b | 1 |
| $a equal to $b | 0 |
| $a less than $b | -1 |
@sorted = sort { $a <=> $b } @not_sorted # numerical sort or @sorted = sort { $a cmp $b } @not_sorted # ASCII-betical sort or better @sorted = sort { lc($a) cmp lc($b) } @not_sorted # alphabetical sort Looking at the sort function, we notice that it is exactly as we described it in words, earlier in this article. Perl needs just two things: the list of items to sort, and a subroutine that answers the question "how do these two compare?" for any pair of items in the list. Perl puts the two items it want to compare int the special variables $a and $b and your function is responsible to give a return value that corresponds to the existing relationship of the two, as shown in the table shown earlier. Here, in this simple example, we used perl's built-in comparison operators that work for numerical and alphabetical (not realy... to be correct it is ASCII order) sorting. Of course, you can roll your own comparison function to create sorts for any kind of ordering you wish to have. Before you start coding your own functions, take a look to the following examples: @sorted = sort { $hash{$a} cmp $hash{$b} } keys %hash; @sorted = sort { $b cmp $a } @list; Which can also be done with @sorted = reverse sort { $a cmp $b } @list; @sorted = sort { if ($a eq 'aardvark') { return 1; } elsif ($b eq 'aardvark') { return -1; } else { return $a cmp $b; } } @words;# End of line comments begin with a #
$a = 17; # Scalar variables begin with a dollar symbol
# The Perl assigment operator is =
# Statements finish with a semicolon ;
$b = 0x11; # Hexadecimal (17 in decimal)
$c = 021; # Octal (17 in decimal)
$d = 0b10001; # Binary (17 in decimal)
$f = 3.142; # Floating point
$a = $a + 1; # Add 1 to variable $a
$a += 1; # Add 1 to variable $a
$a++; # Add 1 to variable $a
$b = $b * 10; # Multiply variable $b by 10;
$b *= 10; # Multiply variable $b by 10;
# Other arithmetic operators include:
# ** Exponentiation
# % Modulo division
# ++ Auto increment
# -- Auto decrement
# < Numeric less than
# > Numeric greater than
# == Numeric equality
# != Numeric inequality
# <= Numeric less than or equal to
# >= Numeric greater than or equal to
# <=> Numeric compare: Returns -1 0 1
$a = 'Number of DFFs: '; # No interpolation with 'single quotes'
$b = "$a$c\n"; # Interpolation (variable substitution) with "double quotes"
# \n is the newline character
print $b; # This makes "Number of DFFs: 17\n" appear on the standard output
print $a, $c, "\n"; # As does this line because print takes
# a comma separated list of arguments to print
print "That's all\n"; # No commas means a list of one element
# String operators include:
# lt String less than
# gt String greater than
# le String less than or equal to
# ge String greater than or equal to
# cmp String compare: Returns -1 0 1
print 'one' lt 'two'; # Prints 1
# ASCII-betically 'o' is less than 't'
print 'buf4' lt 'buf3'; # Prints nothing (that is undef, numerically zero)
# Perl's undefined value is undef
# ASCII-betically '4' is not less than '3'
0; # Integer zero 0.0; # Decimal zero '0'; # String containing a single zero character ''; # Empty string undef; # UndefinedEverything else is true. Here are some logical operators:
$a = 0; $b = 45; # More than one statement per line possible
print( $a and $b++ ); # prints 0 *
$a = 22;
print( $a and $b++ ); # prints 45 *
print $b; # prints 46
# * $b++ only evaluated when $a was true
# Some logic operators take shortcuts
# Other logical operators include
# or Logical OR
# || Logical OR
# and Logical AND
# && Logical AND
# not Logical NOT
# ! Logical NOT
# | Bitwise OR
# & Bitwise AND
# ~ Bitwise NOT
print 6 & 5; # prints 4, 0b0110 & 0b0101 = 0b0100
print 6 | 5; # prints 7, 0b0110 | 0b0101 = 0b0111
print ! 0; # prints 1
print ! 5; # prints nothing (that is undef or false)
print ~5; # prints 4294967290, same as:
# 0b11111111111111111111111111111010
@components = ( 'X_LUT4', 'X_AND2', 'X_BUFGMUX', 'X_BUF_PP', 'X_FF' );
# or use qw''. Saves typing commas or quotes, gives the same result
# qw stands for Quoted Words
@components = qw'X_LUT4 X_AND2 X_BUFGMUX X_BUF_PP X_FF';
# or even put the data in columns, gives the same result again
@components = qw'
X_LUT4
X_AND2
X_BUFGMUX
X_BUF_PP
X_FF
'; # Easier to read this way
push( @components, 'X_MUX2' ); # Push another item onto the top
push( @components, 'X_ONE' ); # And one more
print $components[0]; # Prints element 0, that is, 'X_LUT4'
print $components[5]; # Prints element 5, that is, 'X_MUX2'
print "@components\n"; # Prints everything separated by spaces:
# X_LUT4 X_AND2 X_BUFGMUX X_BUF_PP X_FF X_MUX2 X_ONE
print @components ; # No double quotes, no spaces:
# X_LUT4X_AND2X_BUFGMUXX_BUF_PPX_FFX_MUX2X_ONE
while( @components ) {
# ^^^^^^^^^^^^^ Array in scalar context
$next_component = shift( @components );
print "$next_component\n";
}
# Array variable @components is now empty
In this example @components begins with size 7, which is true. After 7 loops each of the 7 elements have been shifted or removed from the bottom of the array. In the while test expression @components would have returned 7, 6, 5, 4, 3, 2, 1 and finally 0. Zero is false, end of while loop. # Initialising several hash keys
%components = qw'
X_LUT4 0
X_AND2 0
X_BUFGMUX 0
X_BUF_PP 0
X_FF 0
';
# ^^^^^^^^^ keys
# ^ values
$components{'X_LUT4'} = 1; # Set key X_LUT4 to the value 1
$components{'X_LUT4'}++; # Increment value associated with X_LUT4
print $components{'X_FF'}; # Print value associated with X_FF
@keys = keys %components; # Get a list of hash keys
print "@keys\n"; # Print them - order is indeterminate
%components = (); # Emptying the components hash
# This script is called process_netlist.pl # Perl scripts often have the file extension .pl $netlist_filename = $ARGV[0]; $report_filename = $ARGV[1]; print " Processing $netlist_filename\n"; print " Writing report to $report_filename\n"; print " ARGV contains '@ARGV'\n"; # Use it in this way: # C:\perl process_netlist.pl chip_timesim.vhd report.txt # Processing chip_timesim.vhd # Writing report to report.txt # ARGV contains 'chip_timesim.vhd report.txt' # C:\
if( $ff_count == 1 )
# ^^^^^^^^^^^^^^ Is this expression true or false?
{
# Do this action if it is true
print "There is 1 flip flop\n";
}
else
{
# Do this action if it is false
print "There are $ff_count flip flops\n";
}
# More compact layout
if( $ff_count == 1 ) {
print "There is 1 flip flop\n";
} else {
print "There are $ff_count flip flops\n";
}
It is not necessary to have an else part. The (round brackets) are required around the expression. The {curly brackets} are required around the actions. # Counting to one hundred
while( $count < 100 ) {
$count++; # Perl assumes $count == 0 the first time
print "$count\n";
}
Variables do not have to be declared or initialised. Perl will create the variable when it is first used. If the variable is first used in a numeric context then its undefined initial value will be interpreted as zero. If the variable is first used in a string context then its undefined initial value will be interpreted as an empty string. Perl's default behaviour makes good sense. Counting begins at zero. Writing begins with an blank page. foreach $course ( 'VHDL', 'SystemVerilog', 'SystemC', 'Perl', 'Tcl/Tk', 'PSL' ) {
print "There is a $course Doulos training course\n";
}
# $course is the loop variable.
# It takes the string value 'VHDL' for the first loop
# and 'PSL' for the last loop.
# Get a list from an array variable
foreach $component ( @components ) {
print "Component is $component\n";
}
open( FILE1, '>file1.txt' ); # ^ > means open in write mode print FILE1 "The first line to file1.txt\n"; print FILE1 "The final line to file1.txt\n"; close( FILE1 ); # Don't have to explicitly close a file print STDOUT "This goes to the standard output\n"; print "So does this\n"; # ^^^^^^ STDOUT is a file handle that always # refers to the standard output. # It is the default so doesn't have to be stated.Text files are read using the open statement and the input record operator. Standard input, the input typed into the keyboard in a command line application, can be read from the STDIN file handle.
open( FILE2, 'file2.txt' ); # Open in read mode - the default mode
$first_line = <FILE2>; # Reads the first line from file2.txt into $first_line.
# Includes the newline character, \n.
while( $line = <FILE2> ) {
print $line; # Read and print remaining lines from file2.txt.
} # When every line has been read <FILE2> returns undef.
$standard_input = <STDIN>; # Read a line from the standard input.
# Can be the keyboard if run from the command line.
chomp( $standard_input ); # Remove the trailing newline character
$netlist_filename = $ARGV[0];
$report_filename = $ARGV[1];
open( FILE_IN, $netlist_filename );
open( FILE_OUT, ">$report_filename" );
while( $line = <FILE_IN> ) {
$line_count++;
print FILE_OUT "$line_count: $line";
}
# perl filter_netlist.pl chip_timesim.vhd report.txt
while( $line = <STDIN> ) {
$line_count++;
print "$line_count: $line";
}
# perl filter_netlist.pl < chip_timesim.vhd > report.txt
$string = "Novice to Expert in a 3 day Perl course.\n";
print $string;
if( $string =~ m/Expert/ ) {
# A successful match returns 1 so this statement is executed
print "This string contains the substring 'Expert'\n";
}
# m stands for match
# Forward slashes are used to /delimit/ regular expressions.
# =~ tells the m operator which string to search.
# The m is optional when // are used.
use English;
$string = "Novice to Expert in a 3 day Perl course.\n";
if( $string =~ /\w+/ ) {
# \w+ matches one or more alphanumeric characters in a row
print "Matched: $MATCH\n"; # Matched: Novice
}Readable English names for some Perl special variables are provided by the English Perl module. $MATCH gets a copy of the substring successfully matched. Without using the English Perl module $MATCH would have to be called $&.use English;
$string = "Novice to Expert in a 3 day Perl course.\n";
if( $string =~ /Perl\s+\w+/ ) {
# ^^^^ matches Perl
# ^^^ matches one or more white space characters
# (including space, tab and newline)
# ^^^ matches one or more alphanumeric characters
print "Matched: $MATCH\n"; # Matched: Perl course
}
# \w? Zero or one letter, digit or underscore
# \w One letter, digit or underscore
# \w* Zero or more letters, digits or underscores
# \w+ One or more letters, digits or underscores
# \W One character but not a letter, digit or underscore
# \s White space character, space, tab or newline
# \S One character but not a space, tab or newline
c4_n001449 : X_LUT4
generic map(
INIT => X"0001"
)
port map (
ADR0 => c4_count(4),
ADR1 => c4_count(18),
ADR2 => c4_count(3),
ADR3 => c4_count(5),
O => CHOICE121_pack_1
);
open( VHDL_FILE, 'chip_timesim.vhd' );
while( $line = <VHDL_FILE> ) {
if( $line =~ /\w+\s*:\s*(X_\w+)/ ) {
# ^^^ Instance label
# ^^^ Zero or more white space characters
# ^ :
# ^^^ Zero or more white space characters
# ^^^^^ Group containing a word beginning with X_
# (copied into $1)
print "Found instantiation of $1\n";
}
}
# Pulling it all together
# Everything in this script is described above
$netlist_filename = $ARGV[0];
open( VHDL_FILE, $netlist_filename );
while( $line = <VHDL_FILE> ) {
if( $line =~ /\w+\s*:\s*(X_\w+)/ ) {
$component_hash{$1}++;
}
}
@name_array = keys %component_hash;
foreach $component_name ( @name_array ) {
print "$component_name: $component_hash{$component_name}\n";
}
Extracting information from text files is easy given a little Perl knowledge. The following output was generated by the above script: X_FF: 56 X_AND2: 29 X_ONE: 25 X_INV_PP: 23 X_BUF_PP: 395 X_ZERO: 4 X_TOC: 1 X_XOR2: 53 X_BUFGMUX: 1 X_OR2: 8 X_ROC: 1 X_MUX2: 96 X_LUT4: 123 X_TRI_PP: 20
my @numbers = (-59, 99, 87, 1900, 42, 1, -999, 30000, 0);
my @sorted = sort { $a <=> $b } @numbers;
print "@sorted\n";
# output: -999 -59 0 1 42 87 99 1900 30000
If you don't specify a block with the spaceship operator to sort() function, it will treat the numbers as strings and sort them asciibetically:my @numbers = (-59, 99, 87, 1900, 42, 1, -999, 30000, 0); my @sorted = sort @numbers; print "@sorted\n"; # output: -59 -999 0 1 1900 30000 42 87 99In general the spaceship operator is defined as following:
perl -lne '}{ print $.' file
Here the Eskimo greets the print function. To understand what happens here, you have to know what the -n command line option does. It causes Perl to assume the following loop around your program:while (<>) {
...
}
Where `...` contains the code specified by the -e command line option. If the code specified is `}{ ...` then it causes the while loop to be closed with no actions to be done and only the `...` part gets executed.while (<>) {
}
{
print $.
}
This just prints the special variable $. which is the number of input lines processed.perl -lne 'code1 }{ code2'
Code1 gets executed within the loop and code2 after the loop is done:while (<>) {
code1
}
{
code2
}
If you are interested in the topic of Perl one-liners, see the first part of my article "Perl One-Liners Explained".my $str = "5 foo 6 bar 7 baz"; my $count =()= $str =~ /\d/g; print $count;This program prints 3 - the number of digits in $str. How does it do it? Let's deparse the 2nd line:
(my $count = (() = ($str =~ /\d/g)));What happens here is that the expression ($str =~ /\d/g) gets assigned to the empty list (). Assigning to a list forces the list context. The whole (() = ($str =~ /\d/g)) thing gets evaluated in list context, but then it gets assigned to a scalar which causes it to get evaluated again in scalar context. So what we have is a list assignment in scalar context. The key thing to remember is that a list assignment in scalar context returns the number of elements on the right-hand side of the list assignment. In this example the right-hand side of the list assignment is ($str =~ /\d/g). This matches globally (/g flag) and finds 3 digits in $str. Therefore the result is 3.
print "these people @{[get_names()]} get promoted"
andprint "these people ", join " ",get_names(), " get promoted"Clearly, the first example wins for code clarity.
print "@{[something]}"
is exactly the same as writingprint join $", something
$ perl -le 'print ~~localtime' Mon Nov 30 09:06:13 2009Here localtime was evaluated in scalar context, even though it was called within print that forces list context. It returned human readable date and time.
$ perl -le 'print localtime' 579301010913330Here localtime returned a list of 9 elements and print function just printed them one after another. To really see that it's a list of 9 elements, let's use the turtle operator:
$ perl -le 'print "@{[localtime]}"'
5 13 9 30 10 109 1 333 0
my $x = 5; print ~-$x; # prints 4It works because ~-$x parses to (~(-$x)), which on a two-complement machine is effectively the same as $x-1.
print -+-"4zy" # prints 4 print -+-'3.99' # prints 3.99 print -+-'2e5' # prints 200000
print 0+"4zy" # prints 4
my @array = ();
Solution
$#array = -1;
Foo::bar()Foo->bar()bar() (if Foo exports it)blessed reference to a hash Perl's object inheritance methods use @ISA to determine what classes a module inherits from. Years ago, inheritance was declared by modifying @ISA directly; now, most programs use the base pragma to declare inheritance.
The following are mostly equivalent:
package Foo;
require Wango;
@ISA = ( "Wango" );
package Foo;
use base "Wango";
source: http://perl101.org/objects.html
References are like pointers in C in that they refer to other variables. Create a reference with the \ operator.
my $sref = \$scalar;
my $aref = \@array;
my $href = \%hash;
my $cref = \&subroutine;
The thing the reference point to is the "referent".
Dereference a reference with the appropriate sigil, preferably in squiggly braces.
my $other_scalar = ${$sref};
my @other_array = @{$aref};
my %other_hash = %{$href};
&{$cref} # Call the referent.
To access array and hashrefs, use the -> operator.
my $stooge = $aref->[1];
my $stooge = $href->{Curly};
refisaref without a good reasonisa is part of the UNIVERSAL package, so you can call it on objects my $mech = WWW::Mechanize->new;
print "ok\n" if $mech->isa('LWP::UserAgent');
Subroutines can be assigned to a variable, then called, allowing code references to be passed around and used at will. This can come in handy if, for example, you're writing a subroutine that needs to execute supplied code as part of its work.
my $casefix = sub { return ucfirst lc $_[0] };
my $color = $casefix->("rED");
print "Color: $color\n"; # prints Red
source: http://perl101.org/references.html