[Perl] script -database

Welcome. I am writing a perl script. I have to design a database consisting of a single table (any subject) saved in a text file. (I make it vi command name and I am giving permission chmod u + x?) The table should contain at least four columns, including a column containing the ID (serial number ) and at least one column of text and numerical data. application written in Perl should allow:
-sort the selected column.

  • adding new rows (lines) to the database - with the auto increment Serial Number (ID)
    -printing lines with possibility of search in any column (using the regular expression specified by the user), the print order of tuples consistent with the natural order in the file

PLEASE guidance, which in turn have to do. Can someone please bring me a little bit, how do the job:) I hope my English is understandable;) :wink:

:wink:

Most of database stuff is done for you already with SQLite and there's a CPAN.org module for it. See module DBD::SQLite. Other methods can be found on the link to DBD from the module. On Linux use your package manager to install it, search for "dbd-sqlite". Windows can install it with PPM but I haven't used that in some time.

I also have packages "sqlite" (command line), "sqlite-doc" (docs) and "sqliteman" (GUI) installed under Linux. This is everything you need to create the database file without PERL. You can learn the syntax and play around with the DB. DB File needs RW access and the directory must be at least X (executable).

PERL access starts with...

use DBI qw(:sql_types);
my $dbfile = "schedule.sqlite";

my $dbh = DBI->connect("dbi:SQLite:$dbfile","","");
my $sth = $dbh->prepare("SELECT * FROM users ORDER BY id");
$sth->execute or die $sth->errstr;
my $row = $sth->fetch;
while (defined($row)) {
    print join("|", @$row), "\n";
    $row = $sth->fetch;
}

$dbh->disconnect;

There are lots of ways to get rows, see all the fetch methods in the DBD module. For example, you can get one row at a time in an array or in a hash, or all the rows at once in an array or array ref, etc. Variables can be bound to columns for easier access.

The table was created from command line. Here's the SQL92 statement.

CREATE TABLE users (id integer primary key, fname varchar(40), lname varchar(40));

SQL92 is a subset of the full standard, see documentation.

Thank you. But it says much to me. Could someone help me write this script?

Thought about it for a long time as this could be a lengthy procedure and I'm a bit busy with my job now. But I can help you in my spare time.

To create your simple database we need to know what's inside it. I can pick column names but if you have something more specific in mind let me know. How about basic inventory?

Columns: Number, Name, Spec, Notes

  1. id, int primary key, Will auto increment with null value.
  2. qty, int8
  3. price, int8, Value is cents or 1=1/100 of dollar.
  4. item, varchar(20), Item name.
  5. desc, varchar(255), Text description.

Sound good? Will post SQL for sqlite and PERL to create DB and insert rows when I have more time. Sorry for delay.

Here's an Sqlite dump of the table def:

CREATE TABLE parts (id integer primary key autoincrement,qty int8 not null,price int8 not null,item varchar(20) not null unique,desc varchar(255) not null);

Here's some PERL code to add items or show a report of the table. No options are implemented.

#!/usr/bin/perl -w

use DBI qw(:sql_types);
my $dbfile = "parts_inventory.sqlite";

sub cmd_add {
    print "add:\n";
    my %record;
    foreach my $f ("item", "desc", "qty", "price") {
        my $aarg = shift(@ARGV);
        if ((! defined($aarg)) || ($aarg eq ":")) {
            # Error: some data is missing.
            printf("%%Error - Add command missing \"%s\".\n", $f);
            exit(1);
        } elsif ($aarg =~ /^-/) {
            # Option
        } else {
            # Data
            $record{$f} = $aarg;
        }
    }
    my $dbh = DBI->connect("dbi:SQLite:$dbfile","","");
    my $cmdh = $dbh->prepare("insert into parts " .
                             "values(null, ?, ?, ?, ?);");
    $cmdh->execute($record{"qty"}, $record{"price"} * 100, $record{"item"}, 
                   $record{"desc"}, ) or die "%Error - " . $cmdh->errstr();
    $dbh->disconnect();
    
}

sub cmd_report {
    print "report:\n";
    dbreport_by_id($dbfile);
}

sub dbcreate($) {
    printf("%%Warning - DBfile \"%s\" missing, creating new file.\n",
          $dbfile);
    # Touch file.
    my $now = time;
    utime($now, $now, $dbfile);

    my $dbh = DBI->connect("dbi:SQLite:$dbfile","","");
    my $cmdh = $dbh->prepare("create table parts (" .
                             "id integer primary key autoincrement," .
                             "qty int8 not null," .
                             "price int8 not null," .
                             "item varchar(20) not null unique," .
                             "desc varchar(255) not null);");
    $cmdh->execute() or die "%Error - " . $cmdh->errstr();
    $dbh->disconnect();
}

sub dbreport_by_id($) {
    my $dbh = DBI->connect("dbi:SQLite:$dbfile","","");
    my $sth = $dbh->prepare("SELECT * FROM parts ORDER BY id;");
    $sth->execute() or die "%Error - " . $sth->errstr();
    while (my $row = $sth->fetch()) {
        $row->[2] /= 100;
        print join("|", @$row), "\n";
    }
    $dbh->disconnect();
}

sub usage ($) {
    my $l = length("Usage - $0");

    print "\nUsage - $0 " . '[ SUBCMD [OPTIONS] DATA ... ] ' .
        '[ [ ":" SUBCMD [OPTIONS] DATA ... ] ... ]' . "\n";
    my $fmt = sprintf("%%%ds %%s\n", $l);
    printf($fmt, " ", "SUBCMD: report R_OPTIONS");
    printf($fmt, " ", "SUBCMD: add A_OPTIONS");
    print "\n";
    exit($_[0]);
}
if (! -e $dbfile) {
    dbcreate($dbfile);
}

# thiscmd [ subcmd [options] data ... ] [ ":" subcmd [options] data ... ] ...
# subcmd = report_cmd | add_cmd
# report_cmd = "report" report_opt [ report_opt ... ]
# report_opt = ( "-ascend" colname ) | ( "-desend" colname ) | 
#    ( "-limit" number )
# colname = "item" | "desc" | "qty" | "price"

# add_cmd = "add" add_data
# add_data = item_name description qty price

my $myprog = $0;
my $arg = shift(@ARGV);
my %cmds = ("add" => \&cmd_add, "report" => \&cmd_report, 
    "help" => \&usage);
if (! defined($arg)) {
    usage(0);
}

while ($arg) {
    # use hash for function call
    if ($arg ne ":") {
        if (exists($cmds{$arg})) {
            # Call subref
            &{$cmds{$arg}}
        } else {
            usage(1);
        }
    }
    $arg = shift(@ARGV);
}