#!/usr/local/bin/perl5

##++
##    Sprite v3.01
##    Last modified: March 5, 1996
##
##    Copyright (c) 1995, 1996
##    Shishir Gundavaram and O'Reilly & Associates
##    All Rights Reserved
##
##    E-Mail: shishir@ora.com
##
##    Permission to use, copy, modify and distribute is hereby granted,
##    providing  that  no charges are involved and the above  copyright
##    notice and this permission appear in all copies and in supporting
##    documentation. Requests for other distribution  rights, including
##    incorporation in commercial  products,  such as  books,  magazine
##    articles, or CD-ROMS should be made to the authors.
##
##    This  program  is distributed in the hope that it will be useful,
##    but WITHOUT ANY WARRANTY;  without  even  the implied warranty of
##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
##
##    NOTE: I'm in  the  process  of  optimizing this module,  and will
##          release a much improved version very soon.
##--

#############################################################################

=head1 NAME

Sprite - Perl 5.0 module to manipulate text delimited databases.

=head1 SYNOPSIS

    use Sprite;

    $rdb = new Sprite ();

    $rdb->set_delimiter ("Read", "::");
    $rdb->set_delimiter ("Write", "::");

    $rdb->sql (<<Query);
        .
        .
        .
    Query

    $rdb->close ();
    $rdb->close ($database);

=head1 DESCRIPTION

Here is a simple database where the fields are delimted by commas:

    Player,Years,Points,Rebounds,Assists,Championships
    ...
    Larry Joe Bird,12,28,10,7,3
    Michael Jordan,10,33,6,5,3
    Earvin Magic Johnson,12,22,7,12,5
    ...

I<Note:> The first line must contain the field names (case sensitive).

=head1 Supported SQL Commands

Here are a list of the SQL commands that are supported by Sprite:

=over 5

=item I<select> - retrieves records that match specified criteria:

    select col1 [,col2] from database
        where (cond1 OPERATOR value1)
        [and|or cond2 OPERATOR value2 ...]

The '*' operator can be used to select all columns.

The I<database> is simply the file that contains the data.
If the file is not in the current directory, the path must
be specified.

Sprite does I<not> support multiple tables (or commonly knows
as "joins").

Valid column names can be used where [cond1..n] and
[value1..n] are expected, such as:

I<Example 1>:

    select Player, Points from my_db
        where (Rebounds > Assists)

The following SQL operators can be used: =, <, >, <=, >=, <>
as well as Perl's special operators: =~ and !~. The =~ and !~
operators are used to specify regular expressions, such as:

I<Example 2>:

    select * from my_db
        where (Name =~ /Bird$/i)

Selects records where the Name column ends with
"Bird" (case insensitive). For more information, look at
a manual on regexps.

=item I<update> - updates records that match specified criteria:

    update database set (cond1 OPERATOR value1)
       where (cond1 OPERATOR value1)
       [and|or cond2 OPERATOR value2 ...]

I<Example>:

    update my_db
        set Championships = (Championships + 1)
        where (Player = 'Larry Joe Bird')

=item I<delete> - removes records that match specified criteria:

    delete from database
        where (cond1 OPERATOR value1)
        [and|or cond2 OPERATOR value2 ...]

I<Example>:

    delete from my_db
        where (Player =~ /Johnson$/i) or
              (Years > 12)

=item I<alter> - simplified version of SQL-92 counterpart

Removes the specified column from the database. The
other standard SQL functions for alter table are not
supported:

    alter table database
        drop column column-name

I<Example>:

    alter table my_db
        drop column Championships

=item I<insert> - inserts a record into the database:

    insert into database
        (col1, col2, ... coln)
    values
        (val1, val2, ... valn)

I<Example>:

    insert into my_db
        (Player, Years, Points, Championships)
    values
        ('Kareem Abdul-Jabbar', 21, 27, 5)

I<Note:> You do not have to specify all of the fields in the
database! Sprite also does not require you to specify
the fields in the same order as that of the database.

I<Note:> You should make it a habit to quote strings.

=back

=head1 METHODS

Here are the three methods that are available:

=over 5

=item I<set_delimiter>

The set_delimiter function sets the read and write delimiter
for the the SQL command. The delimiter is not limited to
one character; you can have a string, and even a regexp (for reading only).

I<Return Value>

None

=item I<sql>

The sql function is used to pass a SQL command to this module. All
of the SQL commands described above are supported. The I<select> SQL
command returns an array containing the data, where the first element
is the status. All of the other other SQL commands simply return a status.

I<Return Value>
    1 - Success
    0 - Error

=item I<close>

The close function closes the file, and destroys the database object.
You can pass a filename to the function, in which case Sprite will
save the database to that file.

I<Return Value>

None

=back

=head1 EXAMPLES

Here are two simple examples that illustrate some of the functions of this
module:

=head2 I<Example 1>

    #!/usr/local/bin/perl5

    use Sprite;

    $rdb = new Sprite ();

    # Sets the read delimiter to a comma (,) character. The delimiter
    # is not limited to one character; you can have a string, or even
    # a regexp.

    $rdb->set_delimiter ("Read", ",");

    # Retrieves all records that match the criteria.

    @data = $rdb->sql (<<End_of_Query);

        select * from /shishir/nba
            where (Points > 25)

    End_of_Query

    # Close the database and destroy the database object (i.e $rdb).
    # Since we did not pass a argument to this function, the data
    # is not updated in any manner.

    $rdb->close ();

    # The first element of the array indicates the status.

    $status = shift (@data);
    $no_records = scalar (@data);

    if (!$status) {
        die "Sprite database error. Check your query!", "\n";
    } elsif (!$no_records) {
        print "There are no records that match your criteria!", "\n";
        exit (0);
    } else {
        print "Here are the records that match your criteria: ", "\n";

        # The database returns a record where each field is
        # separated by the "\0" character.

        foreach $record (@data) {
            $record =~ s/\0/,/g;
            print $record, "\n";
        }
    }

=head2 I<Example 2>

    #!/usr/local/bin/perl5

    use Sprite;

    $rdb = new Sprite ();
    $rdb->set_delimiter ("Read", ",");

    # Deletes all records that match the specified criteria. If the
    # query contains an error, Sprite returns a status of 1.

    $rdb->sql (<<Delete_Query)
                || die "Database Error. Check your query", "\n";

        delete from /shishir/nba
            where (Rebounds <= 5)

    Delete_Query

    # Access the database again! This time, select all the records that
    # match the specified criteria. The database is updated *internally*
    # after the previous delete statement.

    # Notice the fact that the full path to the database does not
    # need to specified after the first SQL command.

    @data = $rdb->sql (<<End_of_Query);

        select Player from nba
            where (Points > 25)

    End_of_Query

    # Sets the write delimiter to the (:) character, and outputs the
    # updated information to the file: "nba.new". If you do not pass
    # an argument to the close function after you update the database,
    # the modified information will not be saved.

    $rdb->set_delimiter ("Write", ":");
    $rdb->close ("nba.new");

    # The first element of the array indicates the status.

    $status = shift (@data);
    $no_records = scalar (@data);

    if (!$status) {
        die "Sprite database error. Check your query!", "\n";
    } elsif (!$no_records) {
        print "There are no records that match your criteria!", "\n";
        exit (0);
    } else {
        print "Here are the records that match your criteria: ", "\n";

        # The database returns a record where each field is
        # separated by the "\0" character.

        foreach $record (@data) {
            $record =~ s/\0/,/g;
            print $record, "\n";
        }
    }

=head1 ADVANTAGES

Here are the advantages of Sprite over mSQL by David Hughes available on
the Net:

Allows for column names to be specified in the update command

Perl's Regular Expressions allows for powerful pattern matching

The database is stored as text. Very Important! Information
can be added/modified/removed with a text editor.

A primary key does not have to be defined; can search/replace
on all keys.

Can add/delete columns anytime

=head1 DISADVANTAGES

Here are the disadvantages of Sprite compared to mSQL:

I<Speed>. Not as fast as mSQL. Sprite was designed to be
used to manipulate very small databases (~1000-2000 records).

Does not have the ability to "join" multiple tables (databases)
during a search operation. This will be added soon!

=head1 RESTRICTIONS

=over 5

=item 1

If a value for a field contains the comma (,) character or the field
delimiter, then you need to quote the value. Here is an example:

    insert into $database
    (One, Two)
    values
    ('$some_value', $two)

The information in the variable $some_value I<might> contain
the delimiter, so it is quoted -- you can use either the single
quote (') or the double quote (").

=item 2

All single quotes and double quotes within a value must be escaped.
Looking back at the previous example, if you think the variable
$some_value contains quotes, do the following:

    $some_value =~ s/(['"])/\\$1/g;

=item 3

If a field's value contains a newline character, you need to convert
the newline to some other character (or string):

    $some_value =~ s/\n/<BR>/g;

=item 4

If you want to search a field by using a regular expression:

    select * from $database
        where (Player =~ /Bird/i)

the only delimiter you are allowed is the standard one (i.e I</../>).
You I<cannot> use any other delimeter:

    select * from $database
        where (Player =~ m|Bird|i)

=item 5

Field names can only be made up of the following characters:

    "A-Z", "a-z", and "_"

In other words,

    [A-Za-z_]

=back

=head1 SEE ALSO

RDB (available at the Metronet Perl archive)

=head1 REVISION HISTORY

=over 5

=item v3.01 - March 5, 1996

Fixed a bug in I<parse_expression> subroutine so that it recognizes
the "_" character as valid in field names.

=item v3.0 - Febraury 20, 1996

Totally re-wrote parser; works reasonably well even in the worst case
scenarios.

=item v2.0 - November 23, 1995

Fixed *numerous* errors in parsing, and added pod style documentation.

=item v1.5 - September 10, 1995

Created Perl 5 module instead of a command-line interface.

=item v1.0 - September 7, 1995

Initial Release

=back

=head1 COPYRIGHT INFORMATION

         Copyright (c) 1995, 1996 by Shishir Gundavaram
                     All Rights Reserved

 Permission to use, copy, and  distribute  is  hereby granted,
 providing that the above copyright notice and this permission
 appear in all copies and in supporting documentation.

=cut

###############################################################################

package Sprite;

$Sprite::exclusive_lock = 2;
$Sprite::unlock = 8;

#++
#  Public Methods and Constructor
#--

sub new
{
    my ($self) = {};
    bless $self;
    $self->initialize ();
    return $self;
}

sub initialize
{
    my ($self) = @_;

    $self{'DB_commands'} = '^(select|update|delete|alter|insert)';

    $self->define_errors ();
    $self->set_delimiter ();

    return (1);
}

sub set_delimiter
{
    my ($self, $type, $delimiter) = @_;

    $type =~ tr/A-Z/a-z/;

    if ($type eq "read") {
        $self{'DB_read'} = $delimiter;
    } elsif ($type eq "write") {
        $self{'DB_write'} = $delimiter;
    } else {
        $self{'DB_read'} = $self{'DB_write'} = ",";
    }

    return (1);
}

sub sql
{
    my ($self, $sql_query) = @_;
    my ($command, $sql_status);

    $sql_query =~ s/\n/ /g;
    $sql_query =~ s/^\s*(.*?)\s*$/$1/;

    if ($sql_query =~ /^$self{'DB_commands'}/io) {
        $command = $&;

        $sql_status = $self->$command ($sql_query);

        if ($sql_status <= 0) {
            $self->display_error ($sql_status);
            return (0);
        } else {
            if ($command eq "select") {
                return 1, (@{$sql_status});
            } else {
                return (1);
            }
        }
    } else {
        return (0);
    }
}

sub display_error
{
    my ($self, $error) = @_;
    my ($message);

    print STDERR ${$self{'DB_errors'}}->{$error}, "\n";
        
    return (1);
}

sub close
{
    my ($self, $file) = @_;
    my ($status);

    $status = 1;

    if ($file) {
        $status = $self->write_file ($file);

        if (!$status) {
            $self->display_error ($status);
        }
    }

    $self->clear_global_vars ();

    return ($status);
}

#++
#  Private Methods
#--

sub define_errors
{
    my ($self) = @_;
    my ($errors);

    $errors = {};

    $$errors{'-501'} = 'Could not open specified database.';
    $$errors{'-502'} = 'Specified column(s) not found.';
    $$errors{'-503'} = 'Incorrect format in [select] statement.';
    $$errors{'-504'} = 'Incorrect format in [update] statement.';
    $$errors{'-505'} = 'Incorrect format in [delete] statement.';
    $$errors{'-506'} = 'Incorrect format in [drop column] statement.';
    $$errors{'-507'} = 'Incorrect format in [alter table] statement.';
    $$errors{'-508'} = 'Incorrect format in [insert] command.';
    $$errors{'-509'} = 'The no. of columns does not match no. of values.';
    $$errors{'-510'} = 'A severe error! Check your query carefully.';
    $$errors{'-511'} = 'Cannot write the database to output file.';
    $$errors{'-512'} = 'Unmatched quote in expression.';

    $self{'DB_errors'} = \$errors;

    return (1);
}

sub clear_global_vars
{
    my ($self) = @_;

    undef ( @{$self{'DB_records'}} );
    undef ( $self{'DB_records'} );

    undef ( $self{'DB_file'} );
    undef ( $self{'DB_table'} );
    undef ( $self{'DB_fields'} );

    undef ( $self{'DB_write'} );
    undef ( $self{'DB_read'} );
    undef ( $self{'DB_commands'} );

    undef ( %{$self} );

    return (1);
}

sub parse_expression
{
    my ($self, $query) = @_;

    ### The expression: "([^"\\]*(\\.[^"\\]*)*)" was provided by
    ### Jeffrey Friedl. Thanks Jeffrey!

    $query =~ s#"([^"\\]*(\\.[^"\\]*)*)"|'([^'\\]*(\\.[^'\\]*)*)'|(m{0,1})/([^/
\\]*(\\.[^/\\]*)*)/(i{0,1})|([A-Za-z_]+)|([`;])#

        if     ($1)    { qq|"$1"|; }
        elsif  ($3)    { qq|"$3"|; }
        elsif  ($6)    { "$5/$6/$8"; }
        elsif  ($9)    { if ( ($9 eq "and") || ($9 eq "or") ) { "$9"; }
                         else { "\$\$_{$9}"; } }
        elsif  ($10)   { ""; }

    #ge;

    $query =~ s/>=\s*(['"])/ ge $1/g;
    $query =~ s/<=\s*(['"])/ le $1/g;
    $query =~ s/=\s*(['"])/ eq $1/g;
    $query =~ s/<>\s*(['"])/ ne $1/g;
    $query =~ s/<\s*(['"])/ lt $1/g;
    $query =~ s/>\s*(['"])/ gt $1/g;

    $query =~ s/([^><!])=([^~])\s*/$1 == $2/g;
    $query =~ s/<>/ != /g;

    return ($query);
}

sub check_columns
{
    my ($self, $column) = @_;
    my (@split_columns, $check_status);

    $check_status = 1;
    @split_columns = split (/,\s*/, $column);

    foreach (@split_columns) {
        $check_status = 0 if ($self{'DB_fields'} !~ /\b$_\b/);
    }

    return ($check_status);
}

sub parse_columns
{
    my ($self, $command, $columns, $condition, $value) = @_;
    my (@all_columns, $parse_code, $column, @temp_array,
        $parse_status, $temp_string, $real_value);

    local ($SIG{__WARN__}) = sub { $parse_status = -510 };

    $parse_status = 1;

    @all_columns = split(/,\s*/, $columns);
    $real_value = $value;

    foreach ( @{$self{'DB_records'}} ) {
        if ( (!$condition) || (eval($condition)) ) {
            foreach $column (@all_columns) {
                if ($command eq "select") {
                    $temp_string = join ("\0", $temp_string, $$_{$column});
                } elsif ($command eq "update") {
                    $$_{$column} = eval($value);
                } elsif ($command eq "drop") {
                    delete($$_{$column});
                    $self{'DB_fields'} =~ s/(^|,)$column(,|$)/\$1/;
                    $self{'DB_fields'} =~ s/,$//;
                }
            }

            if ($command eq "select") {
                $temp_string =~ s/^\0//;
                push @temp_array, $temp_string;
                $temp_string = "";
            }

        }
    }

    if ( ($parse_status <= 0) || ($command ne "select") ) {
        return ($parse_status);
    } else {
        return (\@temp_array);
    }
}

sub check_for_reload
{
    my ($self, $file) = @_;
    my ($table, $reload_status);

    $reload_status = 1;
    $table = &get_basename ($file);

    if ( ($self{'DB_table'} ne $table) && ($self{'DB_file'} ne $file) ) {
        stat ($file);

        if ( (-e _) && (-T _) && (-s _) && (-r _) ) {
            if (defined ( @{$self{'DB_records'}} ) ) {
                undef ( @{$self{'DB_records'}} );
                undef ( $self{'DB_records'} );
            }

            $self{'DB_records'} = $self->load_database ($file);
        } else {
            $reload_status = 0;
        }
    }

    return ($reload_status);
}

sub select
{
    my ($self, $query) = @_;
    my ($select_columns, $select_table, $select_condition,
        $values_or_error);

    if ($query =~ /^select\s+([\w\*, ]+)\s+from\s+([\w\-\/\.]+)/i) {
        $select_columns = $1;
        $select_table = $2;

        $self->check_for_reload ($select_table) || return (-501);

        if ($select_columns eq '*') {
            $select_columns = $self{'DB_fields'};
        }

        $self->check_columns ($select_columns)  || return (-502);

        if ($query =~ /\s+where\s+(.+)$/i) {
            $select_condition = $self->parse_expression ($1);
        }

        $values_or_error = $self->parse_columns ("select",
                                                 $select_columns,
                                                 $select_condition, undef);

        return ($values_or_error);
    } else {
        return (-503);
    }
}

sub update
{
    my ($self, $query) = @_;
    my ($update_table, $update_condition, $status);

    if ($query =~ /^update\s+([\w\-\/\.]+)\s+set\s+(\w+)\s*=\s*\((.+?)\)/i) {
        $update_table = $1;
        $update_columns = $2;
        $update_value = join ("", "(", $3, ")");
        $update_value = $self->parse_expression ($update_value);

        $self->check_for_reload ($update_table) || return (-501);
        $self->check_columns ($update_columns)  || return (-502);

        if ($query =~ /\s+where\s+(.+)$/i) {
            $update_condition = $self->parse_expression ($1);
        }

        $status = $self->parse_columns ("update", $update_columns,
                                        $update_condition, $update_value);

        return ($status);
    } else {
        return (-504);
    }
}

sub delete
{
    my ($self, $query) = @_;
    my ($delete_table, $delete_condition, $status);

    if ($query =~ /^delete\s+from\s+([\w\-\/\.]+)\s+where\s+(.+)$/i) {
        $delete_table = $1;
        $delete_condition = $self->parse_expression ($2);

        $self->check_for_reload ($delete_table) || return (-501);

        $status = $self->delete_rows ($delete_table, $delete_condition);

        return ($status);
    } else {
        return (-505);
    }
}

sub delete_rows
{
    my ($self, $table, $condition) = @_;
    my ($delete_code, $loop, $count, $delete_status);

    local ($SIG{__WARN__}) = sub { $delete_status = -510 };

    $delete_status = 1;

    $delete_code = <<Delete_Records;

    \$count = 0;

    foreach ( \@{\$self{'DB_records'}} ) {
        if (eval(\$condition)) {
            undef \%\$_;
            splice (\@{\$self{'DB_records'}}, \$count, 1);
        } else {
            \$count++;
        }
    }

    1;

Delete_Records
        
    eval $delete_code;

    return ($delete_status);
}

sub alter
{
    my ($self, $query) = @_;
    my ($alter_table, $alter_column, $status);

    if ($query =~ /^alter\s+table\s+([\w\-\/\.]+)\s+/i) {
        $alter_table = $1;

        if ($query =~ /\s+drop\s+column\s+(\w+)$/i) {
            $alter_column = $1;

            $self->check_for_reload ($alter_table) || return (-501);
            $self->check_columns ($alter_column)   || return (-502);
                                        
            $status = $self->parse_columns ("drop", $alter_column,
                                            undef, undef);

            return ($status);
        } else {
            return (-506);
        }
    } else {
        return (-507);
    }
}

sub insert
{
    my ($self, $query) = @_;
    my ($insert_table, $insert_columns, $insert_values, $status);

    if ($query =~
        /^insert\s+into\s+([\w\-\/\.]+)\s+\((.+?)\)\s+values\s+\((.+?)\)$/i) {

        $insert_table = $1;
        $insert_columns = $2;
        $insert_values = $3;

        $self->check_for_reload ($insert_table) || return (-501);
        $self->check_columns ($insert_columns)  || return (-502);

        $status = $self->insert_data ($insert_columns, $insert_values);
                                        
        return ($status);
    } else {
        return (-508);
    }
}

sub insert_data
{
    my ($self, $columns, $values) = @_;
    my (@split_columns, @split_values, $code, $temp_hash,
        $no_columns, $no_values, $insert_status);

    local ($SIG{__WARN__}) = sub { $insert_status = -510 };

    $insert_status = 1;
    @split_columns = split (/,\s*/, $columns);

    @split_values = $self->quotewords (",", $values);

    $no_columns = $#split_columns;
    $no_values = $#split_values;

    if ($no_columns == $no_values) {
        $temp_hash = {};

        for ($loop=0; $loop <= $no_columns; $loop++) {
            $_ = $split_columns[$loop];

            if ($self{'DB_fields'} =~ /\b$_\b/) {
                $$temp_hash{$_} = $split_values[$loop];
            }
        }

        push @{$self{'DB_records'}}, $temp_hash;

        return ($insert_status);
    } else {
        return (-509);
    }
}

sub write_file
{
    my ($self, $new_file) = @_;
    my (@all_columns, $column, $column_data, $temp_string, $write_status);

    $write_status = 1;

    if ( open (RDB_FILE, ">" . $new_file) ) {
        flock (RDB_FILE, $Sprite::exclusive_lock);

        $self{'DB_fields'} =~ s/,\s*/$self{'DB_write'}/g;

        print RDB_FILE $self{'DB_fields'}, "\n";

        @all_columns = split(/$self{'DB_write'}/, $self{'DB_fields'});

        foreach ( @{$self{'DB_records'}} ) {
            foreach $column (@all_columns) {
                $column_data = $$_{$column};
                $column_data =~ s/(['"])/\\$1/g;

                if ($column_data =~ /($self{'DB_write'})|(['"])/) {
                        $column_data = qq|"$column_data"|;
                }
                        
                $temp_string = join ($self{'DB_write'},
                                     $temp_string, $column_data);
                                                
            }

            $temp_string =~ s/^$self{'DB_write'}//;
            print RDB_FILE $temp_string, "\n";
            $temp_string = "";
        }

        flock (RDB_FILE, $Sprite::unlock);
        close (RDB_FILE);
    } else {
        $write_status = -511;
    }

    return ($write_status);
}

sub get_basename
{
    my ($file_path) = @_;
    my ($basename);

    ($basename) = $file_path =~ m|.*/(.*)|;
    $basename = $file_path unless ($basename);

    return ($basename);
}

sub load_database
{
    my ($self, $file) = @_;
    my (@fields, @database, @record, $hash, $loop, $no_fields);

    open (RDB_FILE, "<" . $file);
    flock (RDB_FILE, $Sprite::exclusive_lock);

    $self{'DB_table'} = &get_basename ($file);
    $self{'DB_file'} = $file;

    $_ = <RDB_FILE>;
    s/^\s*(.*?)\s*$/$1/;

    @fields = split(/$self{'DB_read'}/);
    $self{'DB_fields'} = join (",", @fields);
    $no_fields = $#fields;

    @database = ();

    while (<RDB_FILE>) {
        s/^\s*(.*?)\s*$/$1/;
        next if (!$_);

        @record = $self->quotewords ($self{'DB_read'}, $_);
        $hash = {};

        for ($loop=0; $loop <= $no_fields; $loop++) {
            $$hash{$fields[$loop]} = $record[$loop];
        }

        push @database, $hash;
    }
        
    flock (RDB_FILE, $Sprite::unlock);
    close (RDB_FILE);

    return \@database;
}

###
### NOTE: Derived from lib/Text/ParseWords.pm. Thanks Hal!
###

sub quotewords {
    my ($self, $delim, $line) = @_;
    my (@words, $snippet, $field);

    $_ = $line;

    while ($_) {
        $field = '';

        for (;;) {
            $snippet = '';

            if (s/^"([^"\\]*(\\.[^"\\]*)*)"//) {
                $snippet = $1;
            } elsif (s/^'([^'\\]*(\\.[^'\\]*)*)'//) {
                $snippet = $1;
            } elsif (/^["']/) {
                $self->display_error (-512);
                die;
            } elsif (s/^\\(.)//) {
                $snippet = $1;
            } elsif (!$_ || s/^$delim//) {
               last;
            } else {
                while ($_ && !(/^$delim/ || /^['"\\]/)) {
                   $snippet .=  substr($_, 0, 1);
                   substr($_, 0, 1) = '';
                }
            }

            $field .= $snippet;
        }

        $field =~ s/\\(.)/$1/g;
        $field =~ s/^\s*(.*?)\s*$/$1/;

        push(@words, $field);
    }
    @words;
}

1;