Perl Tutorial - Practical Extraction and Reporting Language (Perl)

Please leave a remark at the bottom of each page with your useful suggestion.

Perl Database Program

Available DBI Drivers and Data Sources

 #!/usr/bin/perl
use warnings;
use strict;
use DBI;
my @drivers=DBI->available_drivers('quiet');
my @sources;
foreach my $driver (@drivers) {
    print "$driver\n";
    @sources=eval { 
        DBI->data_sources($driver) 
    };
    if ($@) {
        print "\tError: ",substr($@,0,60),"\n";
    } elsif (@sources) {
        foreach (@sources) {
            print "\t$_\n";
        }
    } else {
        print "\tNo known data sources\n";
    }
}

Binding Columns

 use DBI;
my $driver="DBI:mysql";
my $database="sample_db";
my $user="root";
my $host="localhost";
my $dbh = DBI->connect("$driver:database=$database;host=$host;user=$user")or die "Can't connect: " . DBI->errstr;
my $sth=$dbh->prepare("SELECT name FROM Employee") or die "Can't prepare sql statement" . DBI->errstr;
$sth->execute() or die "Can't prepare sql statement". $sth->errstr;
my($name);
$sth->bind_columns(\$name);
printf"\t%-20s%\n","Name"
while( $sth->fetch()){
     printf "   %-25s\n",$name;
}
$sth->finish();
$dbh->disconnect();

Commit and Rollback

 use DBI qw(:sql_types);
my $dbh = DBI->connect('dbi:mysql:sample_db','root','password',{
                          PrintError => 0,
                          RaiseError => 1,
                          AutoCommit => 0
                        }
         ) or die "Connection to sample_db failed: $DBI::errstr";
my @rows = ( 
               [ 'A', 3, 5 ],
               [ 'B', 2, 3 ],
               [ 'C', 2, 0 ],
               [ 'D', 6, 0 ],
          );
my $sql = qq{ INSERT INTO teams VALUES ( ?, ?, ? ) };
my $sth = $dbh->prepare( $sql );
foreach $param (@rows) {
    eval { 
        $sth->bind_param( 1, $param->[0], SQL_VARCHAR );
        $sth->bind_param( 2, $param->[1], SQL_INTEGER );
        $sth->bind_param( 3, $param->[2], SQL_INTEGER);
        $sth->execute() or die;
    };
}
if( $@ ) { # If eval failed. $@ is set to the error that occurred
     warn "Database error: $DBI::errstr\n";
     $dbh->rollback(); # Reverse all commit statements
}
else{
   $dbh->commit();
   print "Success!\n";
}
$sth->finish();
$dbh->disconnect();

Connect to mysql

 $dsn = dbi:mysql:northwind; $username="root"; $password="letmein";
$dbh = DBI->connect($dsn, $user, $password,{ PrintError => 0, RaiseError => 1, AutoCommit => 0 });

Connect to Oracle

 $dbh = DBI->connect('dbi:Oracle:payroll','scott','tiger');
$dbh = DBI->connect("dbi:Oracle:host=torch.cs.dal.ca;sid=TRCH",$user, $passwd);

Connect with OLE

 #!c:/perl/bin
use Win32::OLE;
use Win32::OLE::Const 'Microsoft ActiveX Data Objects';
$table    = "addresstable";
$conn = Win32::OLE->new("ADODB.Connection");
$rs   = Win32::OLE->new("ADODB.Recordset");
$conn->Open("address");
print "Content-Type:text/html\n\n";
print "Address Book<br>";
print "<table><tr><th>First Name</th>";
print "<th>Last Name</th><th>Address</th></tr>";
$sql = "SELECT * FROM $table";
$rs->Open($sql, $conn, 1, 1);
while(!$rs->EOF){
   $firstname = $rs->Fields('firstname')->value;
   $lastname  = $rs->Fields('lastname')->value;
   $address   = $rs->Fields('address')->value;
   print "<tr><td>$firstname</td><td>$lastname</td><td>$address</td></tr>";
   $rs->MoveNext;
  }
print "</table></div>";
$rs->Close;
$conn->Close;

Copying from One DBM Format to Another

 #!/usr/bin/perl
use warnings;
use strict;
use POSIX;
use NDBM_File;
use GDBM_File;
my (%ndbm_db,%gdbm_db);
my $ndbm_file='/tmp/my_old_ndbm_database';
my $gdbm_file='/tmp/my_new_gdbm_database';
tie %ndbm_db, 'NDBM_File',$ndbm_file, O_RDONLY, 0;
tie %gdbm_db, 'GDBM_File',$gdbm_file, O_CREAT|O_WRONLY, 0644;
%gdbm_db=%ndbm_db;
untie %ndbm_db;
untie %gdbm_db;

Create, add, delete, and close a DBM file and how to create a Perl-style report.

 #!/usr/bin/perl
use AnyDBM_File;  
dbmopen(%states, "statedb", 0666[a]) || die;
TRY:  {
     print "State Abbreviation:";
     chomp($abbrev=<STDIN>);
     $abbrev = uc $abbrev;  
     print "Name of the state:";
     chomp($state=<STDIN>);
     lc $state;
     $states{$abbrev}="\u$state"; 
     print "Another entry? ";
     $answer = <STDIN>;
     redo TRY  if $answer =~ /Y|y/;
}
dbmclose(%states);

Creating and Assigning Data to a DBM File

 #Format:
#dbmopen(hash, dbfilename, mode);
#tie(hash, Module , dbfilename, flags, mode);
dbmopen(%myhash, "mydbmfile", 0666);
tie(%myhash,SDBM_File, "mydbmfile", O_RDWR|O_CREAT,0640);

Creating an HTML Table

 #!/usr/bin/perl
use DBI;
use strict;
use CGI qw/:standard/;
my $username = "dbuser";
my $password = "dbpassword";
my $dsn = "dbi:mysql:mysql:192.168.1.10";
my $dbh = DBI->connect($dsn,$username,$password)
  or die "Cannot connect to database: $DBI::errstr";
my $sth = $dbh->prepare("SELECT host,user FROM mysql.user");
$sth->execute()
    or die "Cannot execute sth: $DBI::errstr";
print header,
        start_html('MySQL Hosts and Users'),
        table({-border=>1}),
                Tr({-align=>'CENTER',-valign=>'TOP'},
                [
                        th(['User','Host'])
                ]);
while (my ($hostname,$username) = $sth->fetchrow_array()) {
        if ($hostname eq "") {
                $hostname = "<b>undef</b>";
        }
        print Tr({-align=>'CENTER',-valign=>'TOP'},
                [td(["$username","$hostname"])
                ]);
}
print end_html;
$dbh->disconnect();

Creating a Web Page Integrated with SQL Data

 #!/usr/bin/perl
use DBI;
use strict;
use CGI qw/:standard/;
my $username = "dbuser";
my $password = "dbpassword";
my $dsn = "dbi:mysql:mysql:192.168.1.10";
my $dbh = DBI->connect($dsn,$username,$password) or die "Cannot connect to database: $DBI::errstr";
my $hosttolookup = "%";
my $sth = $dbh->prepare("SELECT host FROM mysql.user WHERE host LIKE ?");
$sth->execute($hosttolookup) or die "Cannot execute sth: $DBI::errstr";
my @mysqlhosts;
while (my $hostname = $sth->fetchrow_array()) {
    if ($hostname =~ /%/) {
        push (@mysqlhosts,$hostname);
    }
}
print header,
      start_html('MySQL Hosts Using Wildcards');
my $count = @mysqlhosts;
if ($count == 0) {
    print p("No Hosts Using Wildcards");
}
else {
    while (<@mysqlhosts>) {
        print p("Host Wildcard: $_");
    }
}
print end_html;
$dbh->disconnect();

DBI ODBC

 #!/usr/bin/perl
use warnings;
use strict;
use DBI;
use DBD::ODBC;
my $dbh = DBI->connect( "dbi:ODBC:employeeDB", "", "", { RaiseError => 1 } );
 
my $IDdel = "1";
my $query = "DELETE FROM employee WHERE EmployeeID = '$IDdel'";
print( "$query \n\n" );
$dbh->do( $query ); 
my $sth = $dbh->prepare( q{ select * FROM employee } );
$sth->execute();
my @array;
while ( @array = $sth->fetchrow_array() ) {
   write( STDOUT );
}
# Clean up
warn( $DBI::errstr ) if $DBI::err;
$dbh->disconnect();
$sth->finish();
format STDOUT =
@<<<<<<@<<<<<<<<<@<<<<<<<<<<@<<<<<@<<<<<<<<<<<
$array[ 0 ], $array[ 1 ], $array[ 2 ], $array[ 3 ], $array[ 4 ]
.

Delete a record from the database

 #!/usr/bin/perl
use warnings;
use strict;
use DBI;
use DBD::ODBC;
my $dbh = DBI->connect( "dbi:ODBC:employeeDB", "", "", { RaiseError => 1 } );
 
my $IDdel = "1";
my $query = "DELETE FROM employee WHERE EmployeeID = '$IDdel'";
print( "$query \n\n" );
$dbh->do( $query ); 
my $sth = $dbh->prepare( q{ select * FROM employee } );
$sth->execute();
my @array;
while ( @array = $sth->fetchrow_array() ) {
   write( STDOUT );
}
# Clean up
warn( $DBI::errstr ) if $DBI::err;
$dbh->disconnect();
$sth->finish();
format STDOUT =
@<<<<<<@<<<<<<<<<@<<<<<<<<<<@<<<<<@<<<<<<<<<<<
$array[ 0 ], $array[ 1 ], $array[ 2 ], $array[ 3 ], $array[ 4 ]
.

Delete records in a database with OLE connection

 use Win32::OLE;
use Win32::OLE::Const 'Microsoft ActiveX Data Objects';
$table = "addresstable";
$conn = Win32::OLE->new("ADODB.Connection");
$rs   = Win32::OLE->new("ADODB.Recordset");
print "Content-type: text/html\n\n";
$conn->Open("address");
$conn->Execute("DELETE * FROM $table WHERE firstname='A'");
print "Record Deleted ...";
$rs->Close;
$conn->Close;

Delete statement and DBI ODBC connection

 #!C:/perl/bin
use DBI;
$dbhandle = DBI->connect("dbi:ODBC:address");
$sqlstatement="DELETE * FROM emp WHERE address='I'";
print "Content-type: text/html \n\n";
$statementhandle = $dbhandle->prepare($sqlstatement);
$statementhandle->execute || die "<br><br>Could not execute SQL statement ... <br>";
print "<br><br>Executed ...<br>";
$dbhandleandle->disconnect();
$statementhandle->finish();

Deleting Entries

 use DBI;
my $driver="DBI:mysql";
my $database="sample_db";
my $user="root";
my $host="localhost";
my $dbh = DBI->connect("$driver:database=$database;host=$host;user=$user") or die "Can't connect: " . DBI->errstr;
print "Name: ";
chomp($name=<STDIN>);
my $sth=$dbh->prepare('SELECT count(*) from Employee WHERE name = ?');
$sth->execute($name);
print "Number of rows to be deleted: ", $sth->fetchrow_array(), "\n";
$num=$dbh->do(qq/DELETE from Employee WHERE name = ?/, undef,$name);
print ($num > 1 ?"$num rows deleted.\n":"$num row deleted.\n");
$sth->finish();
$dbh->disconnect();

Deleting Entries from a DBM File

 #!/bin/perl
use AnyDBM_File;
dbmopen(%states, "statedb", 0666) || die;
TRY: {
     print "state abbreviation to remove. ";
     chomp($abbrev=<STDIN>);
     $abbrev = uc $abbrev;  
     delete $states{"$abbrev"};
     print "$abbrev removed.\n";
     print "Another entry? ";
     $answer = <STDIN>;
     redo TRY  if $answer =~ /Y|y/;  
}
dbmclose(%states);

do() method prepares and executes nonselect, nonrepeating statements in one step.

 #$rows_affected = $dbh->do("UPDATE your_table SET foo = foo + 1");
use DBI;
my $dbh= DBI->connect("DBI:mysql:host=localhost;user=root,password=;database=sample_db");
$dbh->do("INSERT INTO employee(name)VALUES('A')");
my $dbh->disconnect();

Dumping a Query's Results

 #!/usr/bin/perl
use DBI;
use strict;
my $username = "dbuser";
my $password = "dbpassword";
my $dsn = "dbi:mysql:mysql:192.168.1.10";
my $dbh = DBI->connect($dsn,$username,$password) or die "Cannot connect to database: $DBI::errstr";
my $sth = $dbh->prepare("SELECT user,host FROM mysql.user");
$sth->execute() or die "Cannot execute sth: $DBI::errstr";
print $sth->dump_results();
$dbh->disconnect();

Error Diagnostic Variables

 use DBI;
$driver="DBI:mysql";
$database="sample_db";
$user="root";
$host="localhost";
$dbh=DBI->connect('dbi:mysql:sample_db','root','password',{
             RaiseError => 1, 
             PrintError => 0, 
}
) or die $DBI::errstr;
$sth=$dbh->prepare("SELECT name FROM Employee") or die "Can't prepare sql statement" . DBI->errstr;
$sth->execute();
while(my @val = $sth->fetchrow_array()){
    print "name=$val[0]\n";
}
print $sth->rows," rows were retrieved.\n";
$sth->finish();
$dbh->disconnect();

Handling Quotes

 use DBI;
$dbh=DBI->connect(qq(DBI:mysql:database=sample_db;user=root;password=)) or die "Can't connect";
$namestring=qq(O'C);
$namestring=$dbi->quote($string);
print $namestring;
$sth=$dbi->prepare("SELECT * FROM Employee WHERE name=$namestring") or die "Can't prepare sql statement" . DBI->errstr;
$sth->execute();
while(my @val = $sth->fetchrow_array()){
       print "id=$val[0]\n";
       print "name=$val[1]\n";
       print "name=$val[2]\n";
       print "name=$val[3]\n";
       print "start_date=$val[4]\n\n";
}
$sth->finish();
$dbh->disconnect();

Inserting into a Database

 #!/usr/bin/perl
use DBI;
use strict;
my $username = "dbuser";
my $password = "dbpassword";
my $dsn = "dbi:mysql:goo:192.168.1.10";
my $dbh = DBI->connect($dsn,$username,$password) or die "Cannot connect to database: $DBI::errstr";
my $sth = $dbh->prepare("INSERT INTO urls VALUES('','http://www.demo.org/','suehring',unix_timestamp(),'query words')");

$sth->execute() or die "Cannot execute sth: $DBI::errstr";
$dbh->disconnect();

Insert statement with DBI connection

 #!c:/perl/bin
use DBI;
$dbhandlle = DBI->connect("dbi:ODBC:address");
$sqlstatement="INSERT INTO emp (firstname, lastname, address)VALUES ('A', 'T', 'I')";
print "Content-type: text/html \n\n";
$statementhandle = $dbhandlle->prepare($sqlstatement);
$statementhandle->execute || die "<br><br>Could not execute SQL statement ... <br>";
print "<br>Executed ...<br><br>";
$dbhandlleandle->disconnect();
$statementhandle->finish();

Insert value with OLE connection

 #!c:/perl/bin
use Win32::OLE;
use Win32::OLE::Const 'Microsoft ActiveX Data Objects';
$table    = "addresstable";
$conn = Win32::OLE->new("ADODB.Connection");
$rs   = Win32::OLE->new("ADODB.Recordset");
$conn->Open("address");
$conn->Execute("INSERT INTO $table (firstname, lastname, address)
      VALUES ('A','B', 'C')");
print "Content-type: text/html\n\n";
print "Record Added ...";
$rs->Close;
$conn->Close;

Listing Currently Installed Drivers

 #!/usr/bin/perl
use strict;
use DBI;
my @drivers;
@drivers = DBI->available_drivers();
foreach my $dbd (@drivers) {
  print "$dbd driver is available\n";
}
exit;

Listing Valid DSNs

 #!/usr/bin/perl
use strict;
use DBI;
my @drivers;
@drivers = DBI->available_drivers;
foreach my $driver (@drivers) {
  print "$driver driver is available\n";
  my @dsns = DBI->data_sources($driver);
  foreach my $dsn (@dsns) {
    print "\tDSN: $dsn\n";
  }
}

Load text file to database

 #!\usr\bin\perl
use warnings;
use strict;
use DBI;
my ($dbh, $sth, $firstname, $lastname, $destination, $rows);
$dbh=DBI->connect('dbi:mysql:test','root','password') || die "Error opening database: $DBI::errstr\n";
$sth=$dbh->prepare("INSERT INTO employee (firstname, lastname, destination)VALUES (? , ? , ? )");
$rows=0;
while (<>) {
    chomp;
    ($firstname, $lastname, $destination) = split(/:/);
    $sth->execute($firstname, $lastname, $destination)|| die "Couldn't insert record : $DBI::errstr";
    $rows+=$sth->rows();
}
print "$rows new rows have been added to checkin";
$dbh->disconnect || die "Failed to disconnect\n";

MySQL Data Types

 Data Type   Description
TINYINT        between 0 and 255 if UNSIGNED clause is applied; else the range is between -128 and 127.
SMALLINT       between 0 and 65535 (UNSIGNED) or -32768 and 32767.
MEDIUM INT     0 to 16777215 with UNSIGNED clause or -8388608 and 8388607.
INT UNSIGNED   between 0 and 4294967295 or -2147683648 and 2147683647.
BIGINT         Huge numbers (-9223372036854775808 to 9223372036854775807).
FLOAT          Floating point numbers (single precision).
DOUBLE         Floating point numbers (double precision).
DECIMAL        Floating point numbers represented as strings.

Open DBM up for read write access

 #!/usr/bin/perl
use warnings;
use strict;
use POSIX;
use SDBM_File; # or GDBM_File / NDBM_File / AnyDBM_File...
my %dbm;
my $db_file="demo.dbm";
tie %dbm, 'SDBM_File', $db_file, O_RDWR, 0;

Opening an MLDBM database is similar to opening a regular DBM database:

 #!/usr/bin/perl
use warnings;
use strict;
use MLDBM;
use POSIX; #for O_CREAT and O_RDWR symbols
use strict;
my %mldbm;
my $mldb_file="mlanydbmdemo.dbm";
tie %mldbm, 'MLDBM', $mldb_file, O_CREAT|O_RDWR, 0644;

Preparing a Statement Handle and Fetching Results

 use DBI;
$db=DBI->connect('DBI:mysql:sample_db;user=root;password=');
$sth=$db->prepare("SELECT * FROM employee")  or die "Can't prepare sql statement" . DBI->errstr;
$sth->execute();
$sth->dump_results(); 
$sth->finish();
$dbh->disconnect();

Program to insert a new record into the database

 #!/usr/bin/perl
use warnings;
use strict;
use DBI;
use DBD::ODBC;
my $dbh = DBI->connect( "dbi:ODBC:employeeDB", "", "", { RaiseError => 1 } );
 
my $newemploy = "1";
my $newfirst = "first";
my $newlast = "last";
my $querystring = "INSERT INTO employee VALUES ( '$newemploy','$newfirst','$newlast');";
# Execute the statement
$dbh->do( $querystring );
# Now print the updated database
my $sth = $dbh->prepare( q{ SELECT * FROM employee  } );
$sth->execute();
my @array;
while ( @array = $sth->fetchrow_array() ) {
   write();
}
# Clean up
warn( $DBI::errstr ) if $DBI::err;
$sth->finish();
$dbh->disconnect();
format STDOUT = 
@<<<<<<@<<<<<<<<<@<<<<<<<<<<@<<<<<@<<<<<<<<<<<
$array[ 0 ], $array[ 1 ], $array[ 2 ], $array[ 3 ], $array[ 4 ]
.

Pushing Query Results to an Array to Find Wildcard Hosts

 #!/usr/bin/perl
use DBI;
use strict;
my $username = "dbuser";
my $password = "dbpassword";
my $dsn = "dbi:mysql:mysql:192.168.1.10";
my $dbh = DBI->connect($dsn,$username,$password) or die "Cannot connect to database: $DBI::errstr";
my $sth = $dbh->prepare("SELECT host FROM mysql.user");
$sth->execute() or die "Cannot execute sth: $DBI::errstr";
my @mysqlhosts;
while (my $hostname = $sth->fetchrow_array()) {
   push (@mysqlhosts,$hostname);
}
while (<@mysqlhosts>) {
    if ($_ =~ /%/) {
        print "Wildcard host found: $_\n";
    }
}
$dbh->disconnect();

Query a database and display the contents in a table

 #!/usr/bin/perl
use warnings;
use strict;
use DBI;
use DBD::ODBC;
my $dbh = DBI->connect( "DBI:ODBC:employeeDB", "", "" ) or die( "Could not make connection to database: $DBI::errstr" );
my $sth = $dbh->prepare( q{ SELECT * FROM employee } ) or die( "Cannot prepare statement: ", $dbh->errstr(), "\n" );
     
my $rc = $sth->execute() or die( "Cannot execute statement: ", $sth->errstr(), "\n" );
my @array;
while ( @array = $sth->fetchrow_array() ) {
   write();
}
warn( $DBI::errstr ) if $DBI::err;
$sth->finish();
$dbh->disconnect();
format STDOUT =  
@<<<<<<@<<<<<<<<<@<<<<<<<<<<@<<<<<@<<<<<<<<<<<<
$array[ 0 ], $array[ 1 ], $array[ 2 ], $array[ 3 ], $array[ 4 ]
.

Query parameter binding

 use DBI;
my $driver="DBI:mysql";
my $database="sample_db";
my $user="root";
my $password="";
my $host="localhost";
my $dbh = DBI->connect("$driver:$database:$host","$user","$password") or die "Can't connect: " . DBI->errstr;
$sth=$dbh->prepare("SELECT name FROM Employee where name LIKE ?") or die "Can't prepare sql statement" .
DBI->errstr;
$sth->bind_param(1, "Ch%");
$sth->execute();
$sth->dump_results();
$sth->finish();
$dbh->disconnect();

Reads DBM file, printing entries with tie and untie function

 #!/usr/bin/perl -w
# Usage:
#  Perl readDB.pl database
use SDBM_File;
use Fcntl;
# Print format for STDOUT.
format STDOUT=
@<<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$key, $value  
.
$database  = $ARGV[0];
$mode = 0666;
$flags =  O_RDONLY | binary(); 
tie(%execs, 'SDBM_File', $database, $flags, $mode) or die "Can't open \"$database\" due to $!";
while ( ($key,$value) = each(%execs) ) {
    write;
}  
untie(%execs);
sub binary() {
  return O_BINARY if is_windows();
}
sub is_windows() {
    return $^O =~ /^(MS)?Win/;
}

Retrieving an Index ID

 #!/usr/bin/perl
use DBI;
use strict;
my $username = "dbuser";
my $password = "dbpassword";
my $dsn = "dbi:mysql:goo:192.168.1.10";
my $dbh = DBI->connect($dsn,$username,$password) or die "Cannot connect to database: $DBI::errstr";
my $sth = $dbh->prepare("INSERT INTO urls VALUES('','http://www.demo.org/','suehring',unix_timestamp(),'query words')");

$sth->execute() or die "Cannot execute sth: $DBI::errstr";
my $insertid = $dbh->{'mysql_insertid'};
print "$insertid\n";
$dbh->disconnect();

Retrieving Data from a DBM File

 #!/bin/perl
use AnyDBM_File;
dbmopen(%states, "statedb", 0666);
@sortedkeys=sort keys %states;
foreach $key ( @sortedkeys ){
    $value=$states{$key};
    $total++;
    write;
}
dbmclose(%states);    
format STDOUT_TOP=
Abbreviation     State
------------------------------
.
format STDOUT=
@<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<
$key,          $value
.
format SUMMARY=
------------------------------
Number of states:@###
$total
.
$~=SUMMARY;
write;

Retrieving Query Results Listing MySQL Users and Hosts

 #!/usr/bin/perl
use DBI;
use strict;
my $username = "dbuser";
my $password = "dbpassword";
my $dsn = "dbi:mysql:mysql:192.168.1.10";
my $dbh = DBI->connect($dsn,$username,$password)
  or die "Cannot connect to database: $DBI::errstr";
my $sth = $dbh->prepare("SELECT user,host FROM mysql.user");
$sth->execute() or die "Cannot execute sth: $DBI::errstr";
while (my($username,$hostname) = $sth->fetchrow_array()) {
  print "Username is $username. Host is $hostname\n";
}
$dbh->disconnect();

Select, Execute, and Dump the Results

 use DBI;
$db=DBI->connect('DBI:mysql:sample_db;user=root;password=');
$sth=$db->prepare("SELECT * FROM employee") or die "Can't prepare sql statement" . DBI->errstr;
$sth->execute();
$sth->dump_results(); 
$sth->finish();
$dbh->disconnect();

Select, Execute, and Fetch a Row as a Hash

 use DBI;
$dbh=DBI->connect(qq(DBI:mysql:database=sample_db;user=root;password=)) or die "Can't connect";
$sth=$dbh->prepare("SELECT name FROM employee") ;
$sth->execute();
$count=0;
while(  my $row = $sth->fetchrow_hashref()){
    print "Name:    $row->{name}\n";
    $count++;
}
print "There are $count rows in the sample database.\n";
$sth->finish();
$dbh->disconnect();

Select, Execute, and Fetch a Row as an Array

 use DBI;
my $dbh=DBI->connect(qq(DBI:mysql:database=sample_db;user=root;password=)) or die "Can't connect";
my $sth=$dbh->prepare("SELECT name, salary, age FROM employee");
$sth->execute();
while(my @row=$sth->fetchrow_array()){ 
      print "name=$row[0]\n";      
      print "salary=$row[1]\n";    
      print "age=$row[2]\n\n";  
}
print $sth->rows, " rows were retrieved.\n";
$sth->finish();
$dbh->disconnect();

Simple Inserts

 #!\usr\bin\perl
use warnings;
use strict;
use DBI;
my ($dbh, $rows);
$dbh=DBI->connect('dbi:mysql:test','root','password') || die "Error opening database: $DBI::errstr\n";
$rows=$dbh->do("INSERT INTO checkin (firstname, lastname, destination)VALUES ('John', 'Smith', 'Glasgow')")|| die "Couldn't insert record : $DBI::errstr";
print "$rows row(s) added to checkin\n";
$dbh->disconnect || die "Failed to disconnect\n";

Simple query

 #!\usr\bin\perl
use warnings;
use strict;
use DBI;
my ($dbh, $sth);
$dbh=DBI->connect('dbi:mysql:test','root','password') || die "Error opening database: $DBI::errstr\n";
$sth=$dbh->prepare("SELECT * from employee;") ||die "Prepare failed: $DBI::errstr\n";
$sth->execute() ||die "Couldn't execute query: $DBI::errstr\n";
my $matches=$sth->rows();
unless ($matches) {
    print "Sorry, there are no matches\n";
} else {
    print "$matches matches found:\n";
    while (my @row = $sth ->fetchrow_array) {
        print "@row\n";
    }
}
}
$sth->finish();
$dbh->disconnect || die "Failed to disconnect\n";

Store hashes in a DBM file:

 #!/usr/bin/perl
use warnings;
use strict;
use POSIX;
use SDBM_File;
use Storable;
my %dbm;
my $db_file="demo.dbm";
tie %dbm, 'SDBM_File', $db_file, O_CREAT|O_RDWR, 0644;
$dbm{'key'}=Storable::freeze({Name=>"John", Value=>"Smith", Age=>"42"});
my $href=Storable::thaw($dbm{'key'});
my %hash=%{ Storable::thaw($dbm{'key'}) };

Talking with the Database

 #!\usr\bin\perl
use warnings;
use strict;
use DBI;
my $dbh=DBI->connect('dbi:mysql:test','root','password') || die "Error opening database: $DBI::errstr\n";
print "Hello\n";
$dbh->disconnect || die "Failed to disconnect\n";
print "Goodbye\n";

The connect() Method

 $dbh= DBI->connect("dbi:<RDMS>:<database>","<username>","<password>",\%attributes) or die("Couldn't connect");
$dbh=DBI->connect('DBI:mysql:sample_db','root','quigley1') or die "Can't connect";
$dbh=DBI->connect('DBI:mysql:database=sample_db;user=root;password=quigley1');

The First SQL Query

 #!\usr\bin\perl
use warnings;
use strict;
use DBI;
my ($dbh, $sth, $name, $id);
$dbh=DBI->connect('dbi:mysql:test','root','password') || die "Error opening database: $DBI::errstr\n";
$sth=$dbh->prepare("SELECT * from employee;") || die "Prepare failed: $DBI::errstr\n";
$sth->execute() || die "Couldn't execute query: $DBI::errstr\n";
while (( $id, $name) = $sth ->fetchrow_array) {
    print "$name has ID $id\n";
}
$sth->finish();
$dbh->disconnect || die "Failed to disconnect\n";

Update a record in the database

 #!/usr/bin/perl
use warnings;
use strict;
use DBI;
use DBD::ODBC;
my $dbh = DBI->connect( "dbi:ODBC:employeeDB", "", "", { RaiseError => 1 } );
 
my $ID = "1";
my $query = "UPDATE employee SET firstName = 'new Value' WHERE EmployeeID = '$ID'";
   
print( "$query \n" );
$dbh->do( $query );
# Now print the updated database
my $sth = $dbh->prepare( q{ SELECT * FROM employee  } );
$sth->execute();
print( "\n" );
my @array;
while ( @array = $sth->fetchrow_array() ) {
   write();
}
warn( $DBI::errstr ) if $DBI::err;
$sth->finish();
$dbh->disconnect();
format STDOUT = 
@<<<<<<@<<<<<<<<<@<<<<<<<<<<@<<<<<@<<<<<<<<<<<
$array[ 0 ], $array[ 1 ], $array[ 2 ], $array[ 3 ], $array[ 4 ]
.

Update record with OLE connection

 #!c:/perl/bin
use Win32::OLE;
use Win32::OLE::Const 'Microsoft ActiveX Data Objects';
$table = "addresstable";
$conn = Win32::OLE->new("ADODB.Connection");
$rs   = Win32::OLE->new("ADODB.Recordset");
$conn->Open("address");
$conn->Execute("UPDATE $table SET address='A' WHERE firstname='A'");
print "Content-type: text/html\n\n";
print "Record Updated ...";
$rs->Close;
$conn->Close;

Update statement and DBI ODBC connection

 #!c:/perl/bin
use DBI;
$dbhandle = DBI->connect("dbi:ODBC:address");
$sqlstatement="UPDATE emp SET firstname='W', lastname='W' WHERE address='A'";
print "Content-type: text/html \n\n";
$statementhandle = $dbhandle->prepare($sqlstatement);
$statementhandle->execute || die "<br><br>Could not execute SQL statement ... <br>";
print "<br><br>Executed ...<br>";
$dbhandle->disconnect();
$statementhandle->finish();

Use DBI to connect to a database

 #!c:/perl/bin
use DBI;
$dbhandle = DBI->connect("dbi:ODBC:address");
$sqlstatement="SELECT firstname, lastname FROM employee";
print "Content-type: text/html \n\n";
$statementhandle = $dbhandle->prepare($sqlstatement);
$statementhandle->execute || die "<br><br>Could not execute SQL statement ... <br>";
print "<br>Executed ...<br><br>";
while (@row=$statementhandle->fetchrow_array)
{
   print "@row <br>";
}
$dbhandle->disconnect();
$statementhandle->finish();

Using a Placeholder

 use DBI;
my $driver="DBI:mysql";
my $database="sample_db";
my $user="root";
my $host="localhost";
my $dbh = DBI->connect("$driver:$database:$host;user=$user;
password=quigley1")or die "Can't connect: ". DBI->errstr;
my $sth=$dbh->prepare("SELECT name FROM Employee WHERE name = ?") or die "Can't prepare sql statement" . DBI->errstr;
$name="Tom";
$sth->execute($name);
print "Selected data for team \"$name\".\n\n";
while(my @val = $sth->fetchrow_array()){
      print "name=$val[0]\n";
}
$sth->finish();
$dbh->disconnect();

Using DBM databases with reports

 #!/usr/bin/perl -w
#
# Reads DBM file, printing entries.
# 
# Usage:
#  Perl dbmread.pl database
# Print format for STDOUT.
format STDOUT=
@<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$key, $value
.
format STDOUT_TOP=
Program        File Name            page @<<<
$%
.
$database  = $ARGV[0];
$mode = 0666;
dbmopen(%execs, $database, $mode) or die "Cant open \"$database\" due to $!";
while ( ($key,$value) = each(%execs) ) {
    write;
}
dbmclose(%execs);

Using Multiple Placeholders

 use DBI;
my $dbh=DBI->connect("DBI:mysql:host=localhost;user=root;password=;database=sample_db");
my $sth=$dbh->prepare("INSERT INTO employee(name)VALUES(?)");
my $name="Tom";  # set values here
$sth->execute($name);
$sth=$dbh->prepare("SELECT * FROM employee");
$sth->execute();
while(my @val = $sth->fetchrow_array()){
    print "name=$val[0]\n";
}
$sth->finish();
$dbh->disconnect();

Using Placeholders to Insert Multiple Records

 use DBI;
my $dbh=DBI->connect("DBI:mysql:host=localhost;user=root;password=;database=sample_db");
my $sth=$dbh->prepare("INSERT INTO Employee(name)VALUES(?)");
my @rows = (['A'],
             ['B'],
             ['C'],
             ['D'],
            );
foreach my $row (@rows ){
     $name = $row->[0];
     $sth->execute($name);
}
$sth=$dbh->prepare("SELECT * FROM employee");
$sth->execute();
while(my @row = $sth->fetchrow_array()){
   print "name=$row[0]\n";
}
$sth->finish();
$dbh->disconnect();

Write out data into a DBM database

 #The dbmopen function associates a DBM database with a Perl hash or associative array. 
#The dbmopen function takes the following syntax: 
#dbmopen(%hash, $database, $mode) or die "Cant open \"$database\" due to $!";
#The $mode value contains the file permissions used to create the DBM file if it doesnt exist.
         
#When youre done with a DBM database, call dbmclose to close it: 
#dbmclose(%hash)
#You pass the hash to dbmclose, not the database file name.
#!/usr/bin/perl -w
$directory = "db";
$database  = "mydb";
# Read directory.
opendir(DIR, $directory) or die
  "Cant open \"$directory\" due to $!.";
  
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
print "Read $directory.\n";
$mode = 0666;
dbmopen(%execs, $database, $mode) or die "Cant open \"$database\" due to $!";
  
foreach $entry (@sorted) {
    print "$entry\n";
    $fullname = $directory . "/" . $entry;
    # Dont store if . or ..
    if ( ( -x $fullname ) && 
         ( ! -d $fullname ) && 
         ($entry !~ /^\./ ) ) {
        $execs{$entry} = $fullname;
        print "Storing $entry=$fullname\n";
    }
}
dbmclose(%execs);

Writing Portable DBM Programs with the AnyDBM Module

 #!/usr/bin/perl
use strict;
use warnings;
use AnyDBM_File;
use POSIX;
my %dbm;
my $db_file="anydbmdemo.dbm";
tie (%dbm, 'AnyDBM_File', $db_file, O_CREAT|O_RDWR, 0644);
unless (tied %dbm) {
    print "Error opening $db_file $!\n";
} else {
    $dbm{'Created'}=localtime;
    foreach (sort keys %dbm) {
        print "$_ => $dbm{$_}\n";
    }
    untie %dbm;
}

Write Your Comments or Suggestion...

Perl Tutorial - Practical Extraction and Reporting Language (Perl)

Table of Contents

Perl Database Program