SQLite::Work - report on and update an SQLite database.


SQLite-Work documentation Contained in the SQLite-Work distribution.

Index


Code Index:

NAME

Top

SQLite::Work - report on and update an SQLite database.

VERSION

Top

This describes version 0.1002 of SQLite::Work.

SYNOPSIS

Top

    use SQLite::Work;

    my $rep = SQLite::Work->new(%new_args);

    if ($rep->do_connect())
    {
	if ($simple_report)
	{
	    $rep->do_report(%report_args);
	}
	elsif ($multi_page_report)
	{
	    $rep->do_multi_page_report(%report_args);
	}
	elsif ($split_report)
	{
	    $rep->do_split_report(%report_args);
	}
	$rep->do_disconnect();
    }

DESCRIPTION

Top

SQLite::Work is a perl module for interfacing with an SQLite database. It can be used to:

This generates HTML (and non-HTML) reports from an SQLite database, taking care of the query-building and the report formatting. This also has methods for adding and updating the database.

The SQLite::Work::CGI module has extra methods which deal with CGI using the CGI module; the included "show.cgi" and "edit.cgi" are demonstration CGI scripts which use the SQLite::Work::CGI module. There is also the "show.epl" demonstration Embperl script which has the necessary alterations for using this with Embperl.

The sqlreport script uses SQLite::Work to generate reports from the command-line.

The sqlw_mail script uses SQLite::Work::Mail to email reports.

Limitations

This only deals with single tables and views, and simple one-field, two-table joins. More complex joins should be dealt with by making a view.

This only deals with one database at a time.

CLASS METHODS

Top

new

my $rep = SQLite::Work->new( database=>$database_file, row_ids=>{ episodes=>'title_id', }, join_cols=>{ 'episodes+recordings'=>'title_id', } }, report_template=>$template, default_format=>{ 'episodes' => { 'title'=>'title', 'series_title'=>'title', } }, use_package=>[qw(File::Basename MyPackage)], );

Make a new report object.

This takes the following arguments:

database

The name of the SQLite database file. This is required.

row_ids

The default column-name which identifies rows in SQLite is 'rowid', but for tables which have a primary integer key, this doesn't work (even though the documentation says it ought to). Therefore it is necessary to identify, for the given database, which tables need to use a different column-name for this. This gives a hash of table->column names.

join_cols

This covers simple joins of two tables, by providing the name of a commom column on which to join them. This is only used for presenting two tables separately in one report, not for a combined-table report; for that you are required to create a view.

Presenting two tables separately in one report is only done when only one row is being shown from the first table; then a second section shows the matching rows from the other table (if a second table has been asked for). This is mainly used for editing purposes (see SQLite::Work::CGI).

report_template

Either a string containing a template, or string containing the name of a template file. The template variables are in the following format:

<!--sqlr_title-->

The following variables are set for the report:

sqlr_title

Title (generally the table name).

sqlr_contents

The report itself.

index_template

Similar to the report_template, but this is used for the index-pages in multi-page and split reports. It has the same format, but it can be useful to have them as two separate templates as one may wish to change the way the title is treated for indexes versus actual reports.

default_format

This contains the default format to use for the given columns in the given tables, when generating a row_template if a row_template has not been given. This is useful for things like CGI scripts where it isn't possible to know beforehand what sort of row_template is needed.

use_package

This contains an array of package names of packages to "use". This is mainly so that the {&funcname())} construct of the templates (see Text::NeatTemplate) can call functions within these packages (using their fully-qualified names).

OBJECT METHODS

Top

Methods in the SQLite::Work object interface

do_connect

$rep->do_connect();

Connect to the database.

do_disconnect

$rep->do_disconnect();

Disconnect from the database.

do_report

    $rep->do_report(
	table=>$table,
	table2=>$table2,
	where=>\%where,
	not_where=>\%not_where,
	sort_by=>\@sort_by,
	sort_reversed=>\%sort_reversed,
	show=>\@show,
	distinct=>0,
	headers=>\@headers,
	groups=>\@groups,
	limit=>$limit,
	page=>$page,
	layout=>'table',
	row_template=>$row_template,
	outfile=>$outfile,
	report_style=>'full',
	table_border=>1,
	truncate_colnames=>0,
	title=>'',
    );

Select data from a table in the database, and make a HTML report.

Arguments are as follows (in alphabetical order):

distinct

If columns are given to show (see show), then this will ensure that rows with exactly the same values will not be repeated.

groups

An array of group templates (or filenames of files containing group templates). A group template is a template for values which are "grouped" under a corresponding header. The first group in the array is placed just after the first header in the report, and so on.

See headers for more information.

headers

An array of header templates (or filenames of files containing header templates). A header template lays out what values should be put into headers rather than the body of the report. The first header template is given a H1 header, the second a H2 header, and so on. Headers are shown only when the value(s) they depend on change, but they get their values from each row in the report. Therefore the columns used in the headers should match the columns used in the sort_by array.

The column names are the variable names in this template. This has a different format to the report_template; it is more sophisticated.

The format is as follows:

{$colname}

A variable; will display the value of the column, or nothing if that value is empty.

{?colname stuff [$colname] more stuff}

A conditional. If the value of 'colname' is not empty, this will display "stuff value-of-column more stuff"; otherwise it displays nothing.

    {?col1 stuff [$col1] thing [$col2]}

This would use both the values of col1 and col2 if col1 is not empty.

{?colname stuff [$colname] more stuff!!other stuff}

A conditional with "else". If the value of 'colname' is not empty, this will display "stuff value-of-column more stuff"; otherwise it displays "other stuff".

This version can likewise use multiple columns in its display parts.

    {?col1 stuff [$col1] thing [$col2]!![$col3]}

The same format is used for groups and row_template.

layout

The layout of the report. This determines both how rows are grouped, and what is in the generated row_template if no row_template is given.

table

The report is a (group of) tables, each row of the report is a row in the table; a new table occurs after the heading(s).

para

The report is in paragraphs, each row of the report is one paragraph.

list

The report is a (group of) lists, each row of the report is an item in the list; a new list occurs after the heading(s).

fieldval

The rows are not HTML-formatted. The generated row_template is made up of Field:Value pairs, one on each line.

none

The rows are not HTML-formatted. The generated row_template is made up of values, one on each line.

limit

The maximum number of rows to display per page. If this is zero, then all rows are displayed in one page.

not_where

A hash containing the column names where the selection criteria in where should be negated.

outfile

The name of the output file. If the name is '-' then the output goes to STDOUT.

page

Select which page to generate, if limit is not zero.

report_style

The style of the report, especially as regards table layout.

full
medium
compact
bare

row_template

The template for each row. This uses the same format as for headers. If none is given, then a default row_template will be generated, depending on what layout and which columns are going to be shown (see show).

Therefore it is important that if one provides a row_template, that it matches the current layout.

Also note that if a column is given in a header, it will not be displayed in a row, even if it is put into the row_template.

show

An array of columns to select; also the order in which they should be shown when a row_template has not been given.

sort_by

An array of column names by which the result should be sorted.

sort_reversed

A hash of column names where the sorting given in sort_by should be reversed.

table

The table to report on. (required)

table2

A second table to report on. If this is given, and join_cols have been defined, and the result of the query on the first table returns only one row (either because there's only one row, or because limit was set to 1), then a second, simpler, sub-report will be done on this table, displaying all the rows which match the join-value in the first table.

This is only really useful when doing editing with a CGI script.

table_border

For fine-tuning the report_style; if the layout is 'table', then this overrides the default border-size of the table.

table_header

When the report layout is 'table' and the report_style is not 'bare', then this argument can be used to customize the table-header of the report table. This must either contain the contents of the table-header, or the name of a file which contains the contents of the table-header.

If this argument is not given, the table-header will be constructed from the column names of the columns to be shown.

title

The title of the report; if this is empty, a title will be generated.

truncate_colnames

For fine-tuning the report_style; this affects the length of column names given in layouts which use them, that is, 'table' (for all styles except 'bare') and 'para'. If the value is zero, the column names are not truncated at all; otherwise they are truncated to that number of characters.

where

A hash containing selection criteria. The keys are the column names and the values are strings suitable for using in a GLOB condition; that is, '*' is a multi-character wildcard, and '?' is a single-character wildcard. All the conditions will be ANDed together.

Yes, this is limited and doesn't use the full power of SQL, but it's useful enough for most purposes.

do_multi_page_report

    $rep->do_multi_page_report(
	table=>$table,
	table2=>$table2,
	where=>\%where,
	not_where=>\%not_where,
	sort_by=>\@sort_by,
	sort_reversed=>\%sort_reversed,
	show=>\@show,
	headers=>\@headers,
	groups=>\@groups,
	limit=>$limit,
	page=>$page,
	layout=>'table',
	row_template=>$row_template,
	outfile=>$outfile,
	table_border=>1,
	truncate_colnames=>0,
	report_style=>'full',
	link_suffix=>'.html',
    );

Select data from a table in the database, and make a HTML file for EVERY page in the report.

If the limit is zero, or the number of rows is less than the limit, or the outfile is destined for STDOUT, then calls do_report to do a single-page report.

If no rows match the criteria, does nothing and returns false.

Otherwise, it uses the 'outfile' name as a base upon which to build the file-names for all pages in the report (basically appending the page-number to the name), and generates a report file for each of them, and an index-page file which is called the 'outfile' value.

The 'link_suffix' argument, if given, overrides the suffix given in links to the other pages in this multi-page report; this is useful if you're post-processing the files (and thus changing their extensions) or are using something like Apache MultiViews to eliminate the need for extensions in links.

See do_report for information about the rest of the arguments.

do_split_report

    $rep->do_split_report(
	table=>$table,
	split_col=>$colname,
	split_alpha=>$n,
	command=>'Select',
	table2=>$table2,
	where=>\%where,
	not_where=>\%not_where,
	sort_by=>\@sort_by,
	sort_reversed=>\%sort_reversed,
	show=>\@show,
	headers=>\@headers,
	groups=>\@groups,
	limit=>$limit,
	page=>$page,
	layout=>'table',
	row_template=>$row_template,
	outfile=>$outfile,
	table_border=>1,
	truncate_colnames=>0,
	report_style=>'full',
	link_suffix=>'.html',
    );

Build up a multi-file report, splitting it into different pages for each distinct value of the 'split_col' column. (If the outfile is destined for STDOUT, then this will call do_report intead).

The filenames generated will use 'outfile' as a prefix, and the column name and values as the rest; this calls in turn do_multi_page_report to break those into multiple pages if need be. An index-page is also generated, which will be called outfile + colname + .html

If 'split_alpha' is also given and is not zero, then instead of splitting on each distinct value in the 'split_col' column, the split is done by the truncated values of that column; if 'split_alpha' is 1, then the split is by the first letter, if it is 2, by the first two letters, and so on.

The 'link_suffix' argument, if given, overrides the suffix given in links to the other pages in this multi-page report; this is useful if you're post-processing the files (and thus changing their extensions) or are using something like Apache MultiViews to eliminate the need for extensions in links.

See do_report for information about the rest of the arguments.

get_total_matching

    $rep->get_total_matching(
	table=>$table,
	where=>\%where,
	not_where=>\%not_where,
    );

Get the total number of rows which match the selection criteria.

See do_report for the meaning of the arguments.

update_one_row

    if ($rep->update_one_field(
	table=>$table,
	row_id=>$row_id,
	field=>$field,
	update_values=>\%values,
    ))
    {
	...
    }

Update one row; either a single column, or the whole row. Returns 0 if failure, or the constructed update query if success (so that one can be informative).

Sets $rep->{message} with a success message if successful.

add_one_row

    if ($rep->add_one_row(
	table=>$table,
	add_values=>\%values)) { ...
    }

Add a row to a table.

Sets $rep->{message} with a success message if successful.

delete_one_row

    if ($rep->delete_one_row(
	table=>$table,
	row_id=>$row_id)) { ...
    }

Delete a single row.

Sets $rep->{message} with a success message if successful.

do_import_fv

    if ($rep->do_import_fv(
	table=>$table,
	datafile=>$filename,
	row_delim=>"=")) { ...
    }

Import a field:value file into the given table. Field names are taken from the table; rows not starting with a field name "Field:" are taken to be a continuation of the previous field value.

Rows are delimited by the given row_delim argument on a line by itself.

Returns the number of records imported.

Helper Methods

Top

Lower-level methods, generally just called from other methods, but possibly suitable for other things.

make_selections

    my ($sth1, $sth2) = $rep->make_selections(%args);

Make the selection(s) for the matching table(s).

get_tables

my @tables = $self->get_tables();

my @tables = $self->get_tables(views=>0);

Get the names of the tables (and views) in the database.

get_colnames

my @columns = $self->get_colnames($table);

my @columns = $self->get_colnames($table, do_rowid=>0);

Get the column names of the given table.

get_distinct_col

    @vals = $rep->get_distinct_col(
	table=>$table,
	colname=>$colname,
	where=>\%where,
	not_where=>\%not_where,
    );

Get all the distinct values for the given column (which match the selection criteria).

Private Methods

Top

get_template

my $templ = $self->get_template($template);

Get the given template (read if it's from a file)

get_id_colname

$id_colname = $self->get_id_colname($table);

Get the name of the column which is used for row-identification. (Most of the time it is just 'rowid')

get_join_colname

$join_col = $self->get_join_colname($table1, $table2);

Get the name of the column which is used to join these two tables.

col_is_int

my $res = $self->col_is_int(table=>$table, column=>$column);

Checks the column type of the given column in the given table; returns true if it is an integer type.

format_report

$my report = $self->format_report( table=>$table, command=>'Search', columns=>\@columns, force_show_cols=>\%force_show_cols, sort_by=>\@sort_by, headers=>\@headers, table2=>$table2, layout=>'table', row_template=>$row_template, report_style=>'compact', table_header=>$thead, table_border=>1, truncate_colnames=>0, );

Construct a HTML result table

get_row_template

    $row_template = $self->get_row_template(
	table=>$table,
	row_template=>$rt,
	layout=>'table',
	columns=>\@columns,
	show_cols=>\%show_cols,
	nice_cols=>\%nice_cols,
    );

Get or set or create the row template.

set_nice_cols

    %nice_cols = $self->set_nice_cols(
	truncate_colnames=>0,
	columns=>\@columns);

start_section

$sect = $self->start_section(type=>'table', table_border=>$table_border);

Start a new table/para/list The 'table_border' option is the border-size of the table if using table style

end_section

$sect = $self->end_section(type=>'table');

End an old table/para/list

build_where_conditions

Take the %where, %not_where hashes and make an array of SQL conditions.

    @where = $self->build_where_conditions(where=>\%where,
	not_where=>\%not_where);

REQUIRES

Top

    DBI
    DBD::SQLite
    POSIX

    Test::More

    The CGI module requires:

    CGI

    Scripts require:

    Getopt::Long
    Pod::Usage
    Getopt::ArgvFile

INSTALLATION

Top

To install this module, run the following commands:

    perl Build.PL
    ./Build
    ./Build test
    ./Build install

Or, if you're on a platform (like DOS or Windows) that doesn't like the "./" notation, you can do this:

   perl Build.PL
   perl Build
   perl Build test
   perl Build install

In order to install somewhere other than the default, such as in a directory under your home directory, like "/home/fred/perl" go

   perl Build.PL --install_base /home/fred/perl

as the first step instead.

This will install the files underneath /home/fred/perl.

You will then need to make sure that you alter the PERL5LIB variable to find the modules, and the PATH variable to find the script.

Therefore you will need to change: your path, to include /home/fred/perl/script (where the script will be)

	PATH=/home/fred/perl/script:${PATH}

the PERL5LIB variable to add /home/fred/perl/lib

	PERL5LIB=/home/fred/perl/lib:${PERL5LIB}




SEE ALSO

Top

perl(1). DBI DBD::SQLite

BUGS

Top

Please report any bugs or feature requests to the author.

AUTHOR

Top

    Kathryn Andersen (RUBYKAT)
    perlkat AT katspace dot com
    http://www.katspace.com

COPYRIGHT AND LICENCE

Top


SQLite-Work documentation Contained in the SQLite-Work distribution.
package SQLite::Work;
use strict;
use warnings;

our $VERSION = '0.1002';

use DBI;
use POSIX;
use Text::NeatTemplate;

sub new {
    my $class = shift;
    my %parameters = @_;
    my $self = bless ({%parameters}, ref ($class) || $class);
    $self->{message} = '';
    if (!defined $self->{row_ids})
    {
	$self->{row_ids}  = {};
    }

    if (!defined $self->{join_cols})
    {
	$self->{join_cols}  = {};
    }

    $self->{report_template} ||=<<EOT;
<html>
<head><title><!--sqlr_title--></title>
</head>
<body>
<h1><!--sqlr_title--></h1>
<!--sqlr_contents-->
</body>
</html>
EOT
    $self->{index_template} ||=<<EOT;
<html>
<head><title><!--sqlr_title--></title>
</head>
<body>
<h1><!--sqlr_title--></h1>
<!--sqlr_contents-->
</body>
</html>
EOT

    # make the template object
    if ($parameters{use_package})
    {
	for my $pkg (@{$parameters{use_package}})
	{
	    eval "use $pkg" if $pkg;
	    die "invalid use $pkg: $@" if $@;
	}
    }
    $self->{_tobj} = Text::NeatTemplate->new(escape_html=>1);

    return ($self);
} # new

sub do_connect {
    my $self = shift;

    my $database = $self->{database};
    if ($database)
    {
	my $dbh = DBI->connect("dbi:SQLite:dbname=$database", "", "");
	if (!$dbh)
	{
	    $self->print_message("Can't connect to $database: $DBI::errstr");
	    return 0;
	}
	$self->{dbh} = $dbh;
    }
    else
    {
	$self->print_message("No Database given.");
	return 0;
    }
} # do_connect

sub do_disconnect {
    my $self = shift;

    $self->{dbh}->disconnect();
} # do_disconnect

sub do_report {
    my $self = shift;
    my %args = (
	table=>undef,
	command=>'Select',
	limit=>0,
	page=>1,
	table2=>'',
	headers=>[],
	groups=>[],
	sort_by=>[],
	sort_reversed=>{},
	not_where=>{},
	where=>{},
	show=>[],
	layout=>'table',
	row_template=>'',
	outfile=>'',
	report_style=>'full',
	title=>'',
	prev_file=>'',
	next_file=>'',
	@_
    );
    my $table = $args{table};
    my $command = $args{command};
    my @columns = (@{$args{show}}
	? @{$args{show}}
	: $self->get_colnames($table));

    my $total = $self->get_total_matching(%args);

    my ($sth1, $sth2) = $self->make_selections(%args,
	total=>$total);
    $self->print_select($sth1,
	$sth2,
	%args,
	message=>$self->{message},
	command=>$command,
	total=>$total,
	columns=>\@columns,
	);
} # do_report

sub do_multi_page_report {
    my $self = shift;
    my %args = (
	table=>undef,
	command=>'Select',
	limit=>0,
	page=>1,
	table2=>'',
	headers=>[],
	groups=>[],
	sort_by=>[],
	sort_reversed=>{},
	not_where=>{},
	where=>{},
	show=>[],
	layout=>'table',
	row_template=>'',
	outfile=>'',
	report_style=>'full',
	title=>'',
	verbose=>0,
	prev_file=>'',
	prev_label=>'',
	next_file=>'',
	next_label=>'',
	link_suffix=>undef,
	@_
    );
    
    # check if we just want a single page
    if ($args{limit} == 0
	or $args{outfile} eq ''
	or $args{outfile} eq '-')
    {
	return $self->do_report(%args);
    }

    my $total = $self->get_total_matching(%args);
    my $num_pages = ceil($total / $args{limit});
    # if there's only one page, do a single-page report also
    if ($num_pages == 1)
    {
	return $self->do_report(%args, limit=>0);
    }
    if ($num_pages == 0)
    {
	return 0;
    }
    print STDERR "About to generate $num_pages PAGES\n" if $args{verbose};
    # split the outfile into prefix and suffix
    $args{outfile} =~ m#(.*)(\.\w+)$#;
    my $outfile_prefix = $1;
    my $outfile_suffix = ($2 ? $2 : '.html');
    my $link_suffix = (defined $args{link_suffix} ? $args{link_suffix}
	: $outfile_suffix);
    # width of the page-id
    my $digits = ($num_pages < 10 ? 1
	: ($num_pages < 100 ? 2 : 3)
	);

    # stuff for the index page
    my $title_main = ($args{title} ? $args{title} : $args{table});
    # fix up random ampersands
    if ($title_main =~ / & /)
    {
	$title_main =~ s/ & / &amp; /g;
    }
    my $ind_contents;
    $ind_contents = "<ul>";

    # make a report for each page
    for (my $page = 1; $page <= $num_pages; $page++)
    {
	my $outfile = sprintf("%s_%0*d%s",
	    $outfile_prefix, $digits, $page, $outfile_suffix);
	my $outfile_link = sprintf("%s_%0*d%s",
	    $outfile_prefix, $digits, $page, $link_suffix);
	my $prevfile = ($page > 1
			? sprintf("%s_%0*d%s",
				  $outfile_prefix, $digits,
				  $page - 1, $link_suffix)
			: $args{outfile});
	my $prevlabel = ($page > 1
			? sprintf("%s (%d)", $title_main, $page - 1)
			: sprintf("%s Index", $title_main));
	my $nextfile = ($page < $num_pages
			? sprintf("%s_%0*d%s",
				  $outfile_prefix, $digits,
				  $page + 1, $link_suffix)
			: $args{next_file});
	my $nextlabel = ($page < $num_pages
			? sprintf("%s (%d)", $title_main, $page + 1)
			: $args{next_label});
	$self->do_report(%args,
	    outfile=>$outfile,
	    prev_file=>$prevfile,
	    prev_label=>$prevlabel,
	    next_file=>$nextfile,
	    next_label=>$nextlabel,
	    page=>$page);
	print STDERR "$outfile\n" if $args{verbose};
	$ind_contents .=
	    "<li><a href='$outfile_link'>$title_main ($page)</a></li>\n";
    }
    $ind_contents .= "</ul>\n";

    # append the prev-next links, if any
    my $prev_file = $args{prev_file};
    my $prev_label = $args{prev_label};
    $prev_label =~ s/ & / &amp; /g;
    my $next_file = $args{next_file};
    my $next_label = $args{next_label};
    $next_label =~ s/ & / &amp; /g;
    if ($prev_file and $next_file)
    {
	$ind_contents .= "<hr/>\n";
	$ind_contents .= "<p><a href=\"$prev_file\">$prev_label</a> <a href=\"$next_file\">$next_label</a></p>\n";
    }
    elsif ($prev_file)
    {
	$ind_contents .= "<hr/>\n";
	$ind_contents .= "<p><a href=\"$prev_file\">$prev_label</a></p>\n";
    }
    elsif ($next_file)
    {
	$ind_contents .= "<hr/>\n";
	$ind_contents .= "<p><a href=\"$next_file\">$next_label</a></p>\n";
    }

    # and make the index page
    my $out = $self->get_template($self->{index_template});
    $self->{index_template} = $out;
    $out =~ s/<!--sqlr_title-->/$title_main Index/g;
    $out =~ s/<!--sqlr_contents-->/$ind_contents/g;
    my $fh;
    open($fh, ">", $args{outfile})
	or die "Could not open $args{outfile} for writing";
    print $fh $out;
    close($fh);

    return 1;
} # do_multi_page_report

sub do_split_report {
    my $self = shift;
    my %args = (
	table=>undef,
	split_col=>'',
	split_alpha=>0,
	command=>'Select',
	limit=>0,
	page=>1,
	table2=>'',
	headers=>[],
	groups=>[],
	sort_by=>[],
	sort_reversed=>{},
	not_where=>{},
	where=>{},
	show=>[],
	layout=>'table',
	row_template=>'',
	outfile=>'',
	report_style=>'full',
	title=>'',
	verbose=>0,
	debug=>0,
	link_suffix=>undef,
	@_
    );
    
    # check for STDOUT destination
    if ($args{outfile} eq '-')
    {
	return $self->do_report(%args);
    }
    my $split_col = $args{split_col};
    my $split_alpha = $args{split_alpha};

    # split the outfile into prefix and suffix
    my $outfile_prefix = '';
    my $outfile_suffix = '.html';
    if ($args{outfile})
    {
	$args{outfile} =~ m#(.*)(\.\w+)$#;
	$outfile_prefix = $1;
	$outfile_suffix = ($2 ? $2 : '.html');
    }
    my $link_suffix = (defined $args{link_suffix} ? $args{link_suffix}
	: $outfile_suffix);

    my $total = $self->get_total_matching(%args);
    my @split_vals = $self->get_distinct_col(%args,
	colname=>$split_col);
    if ($split_alpha)
    {
	my %split_avals = ();
	foreach my $val (@split_vals)
	{
	    my $a1 = substr(($val||''), 0, ($split_alpha ? $split_alpha : 1));
	    $a1 = uc($a1);
	    $split_avals{$a1} = 1;
	}
	@split_vals = sort keys %split_avals;
    }

    my $two_level_ind = (($split_alpha or @split_vals < 15) ? 0 : 1);

    # stuff for the index page
    my $title_main = ($args{title} ? $args{title} : "$args{table} $split_col");
    my %page_links = ();

    # make a page for each split-value
    my %where = %{$args{where}};
    for (my $i = 0; $i < @split_vals; $i++)
    {
	my $val = $split_vals[$i];
	$val = '' if !$val;
	my $niceval = $val;
	$niceval = $self->{_tobj}->convert_value(value=>$val,
					format=>$self->{default_format}->
					{$args{table}}->{$split_col},
					name=>$split_col)
	    if ($self->{default_format}->{$args{table}}->{$split_col});
	warn "val=$val, niceval=$niceval\n" if $args{debug};

	my $valbase = $self->{_tobj}->convert_value(value=>$niceval,
	    format=>'namedalpha', name=>$split_col);
	my $outfile = sprintf("%s%s%s",
	    $outfile_prefix, $valbase, $outfile_suffix);
	my $outfile_link = sprintf("%s%s%s",
	    $outfile_prefix, $valbase, $link_suffix);

	# previous values
	my $prev_val = '';
	my $prev_niceval = '';
	my $prev_file = '';
	if ($i > 0)
	{
	    $prev_val = $split_vals[$i-1];
	    $prev_niceval = $prev_val;
	    $prev_niceval = $self->{_tobj}->convert_value(value=>$prev_val,
						 format=>$self->{default_format}->
						 {$args{table}}->{$split_col},
						 name=>$split_col)
		if ($self->{default_format}->{$args{table}}->{$split_col});
	    my $prev_valbase = $self->{_tobj}->convert_value(value=>$prev_niceval,
						    format=>'namedalpha',
						    name=>$split_col);
	    $prev_file = sprintf("%s%s%s",
				 $outfile_prefix,
				 $prev_valbase, $link_suffix);
	}

	# next values
	my $next_val = '';
	my $next_niceval = '';
	my $next_file = '';
	if ($i < (@split_vals - 1))
	{
	    $next_val = $split_vals[$i+1];
	    $next_niceval = $next_val;
	    $next_niceval = $self->{_tobj}->convert_value(value=>$next_val,
						 format=>$self->{default_format}->
						 {$args{table}}->{$split_col},
						 name=>$split_col)
		if ($self->{default_format}->{$args{table}}->{$split_col});
	    my $next_valbase = $self->{_tobj}->convert_value(value=>$next_niceval,
						    format=>'namedalpha',
						    name=>$split_col);
	    $next_file = sprintf("%s%s%s",
				 $outfile_prefix,
				 $next_valbase,
				 $link_suffix);
	}

	if ($val and $args{split_alpha})
	{
	    # starts with the value
	    $where{$split_col} = $val . '*';
	}
	else
	{
	    $where{$split_col} = $val;
	}
	my $prev_label = "&lt; $prev_niceval";
	$prev_label =~ s/ & / &amp; /g;
	my $next_label = "$next_niceval -&gt;";
	$next_label =~ s/ & / &amp; /g;
	if ($self->do_multi_page_report(%args,
	    outfile=>$outfile,
	    prev_file=>$prev_file,
	    prev_label=>$prev_label,
	    next_file=>$next_file,
	    next_label=>$next_label,
	    where=>\%where,
	    title=>"$split_col: $niceval"))
	{
	    print STDERR "$outfile\n" if $args{verbose};
	    if ($val)
	    {
		my $label = $val;
		if ($niceval ne $val)
		{
		    $label = $niceval;
		}
		if ($label =~ / & /)
		{
		    # filter out some HTML stuff
		    $label =~ s/ & / &amp; /g;
		}
		$page_links{$val} = "<a href='$outfile_link'>$label</a>\n";
	    }
	    else
	    {
		$page_links{''} = "<a href='$outfile_link'>$split_col (none)</a>\n";
	    }
	}
    }

    #
    # build the index page
    #
    my $ind_contents = '';

    if ($two_level_ind)
    {
	# find out all the alphas in the links
	my %page_alphas = ();
	foreach my $val (keys %page_links)
	{
	    my $a1 = substr(($val||''), 0, ($split_alpha ? $split_alpha : 1));
	    $a1 = uc($a1);
	    $page_alphas{$a1} = 1;
	}
	$ind_contents .= "<p>";
	my @links = ();
	foreach my $a (sort keys %page_alphas)
	{
	    push @links, "<a href='#${a}'>$a</a>" if $a;
	}
	$ind_contents .= join(' | ', @links);
	$ind_contents .= "</p>\n<hr/>\n";
    }
    elsif ($split_alpha)
    {
	$ind_contents .= "<p>";
    }
    else
    {
	$ind_contents .= "<ul>";
    }
    my $prev_a = undef;
    foreach my $indval (sort keys %page_links)
    {
	my $link = $page_links{$indval};
	my $a1 = substr($indval, 0, 1);
	if ($two_level_ind and (!defined $prev_a or $a1 ne $prev_a))
	{
	    if (defined $prev_a)
	    {
		$ind_contents .= "</ul>\n";
	    }
	    $ind_contents .= "<h2 id='$a1'>$a1</h2>\n" if $a1;
	    $ind_contents .= "<ul>";
	    $prev_a = $a1;
	}
	$ind_contents .= ($split_alpha ? ' ' : '<li>');
	$ind_contents .= $link;
	$ind_contents .= ($split_alpha ? ' ' : '</li>');
    }
    $ind_contents .= ($split_alpha ? "</p>\n" : "</ul>\n");

    # and make the index page
    my $out = $self->get_template($self->{index_template});
    $self->{index_template} = $out;
    $out =~ s/<!--sqlr_title-->/$title_main Index/g;
    $out =~ s/<!--sqlr_contents-->/$ind_contents/g;
    my $index_file = sprintf("%s%s%s",
			  $outfile_prefix, $split_col, $outfile_suffix);
    my $fh;
    open($fh, ">", $index_file)
	or die "Could not open $index_file for writing";
    print $fh $out;
    close($fh);
    print STDERR "$index_file\n" if $args{verbose};

} # do_split_report

sub get_total_matching {
    my $self = shift;
    my %args = (
	table=>undef,
	not_where=>{},
	where=>{},
	@_
    );
    my $table = $args{table};

    # build up the query data
    my @where = $self->build_where_conditions(
	where=>$args{where}, not_where=>$args{not_where});
    
    my $total_query = "SELECT COUNT(*) FROM $table";
    if (@where)
    {
	$total_query .= " WHERE " . join(" AND ", @where);
    }
    # get total of the result as if there was no LIMIT
    my $tot_sth = $self->{dbh}->prepare($total_query);
    if (!$tot_sth)
    {
	$self->print_message("Can't prepare query $total_query: $DBI::errstr");
	return 0;
    }
    my $rv = $tot_sth->execute();
    if (!$rv)
    {
	$self->print_message("Can't execute query $total_query: $DBI::errstr");
	return 0;
    }
    my $total = 0;
    my @row;
    while (@row = $tot_sth->fetchrow_array)
    {
	$total = $row[0];
    }
    return $total;

} # get_total_matching

sub update_one_row {
    my $self = shift;
    my %args = (
	table=>'',
	command=>'Update',
	row_id=>undef,
	field=>'',
	update_values=>{},
	@_
    );

    my $table = $args{table};
    my $row_id_name = $self->get_id_colname($table);
    my $row_id = $args{row_id};
    if (!$row_id)
    {
	$self->print_message("Can't update table $table: row-id $row_id_name is NULL");
	return 0;
    }
    my $update_field = $args{field};
    my %update_values = %{$args{update_values}};

    my $update_query = "UPDATE $table SET ";
    my @assignments = ();
    foreach my $ufield (keys %update_values)
    {
	if ($update_values{$ufield} eq 'NULL')
	{
	    push @assignments, "$ufield = NULL";
	}
	elsif ($self->col_is_int(table=>$table, column=>$ufield))
	{
	    push @assignments, "$ufield = ".
		($update_values{$ufield} ? $update_values{$ufield} : '0');
	}
	else
	{
	    push @assignments, "$ufield = ". 
		$self->{dbh}->quote($update_values{$ufield});
	}
    }
    $update_query .= join(', ', @assignments);
    $update_query .= " WHERE $row_id_name = $row_id";
    
    # actual update
    my $rv = $self->{dbh}->do($update_query);
    if (!$rv)
    {
	$self->print_message("Can't execute update $update_query: $DBI::errstr");
	return 0;
    }
    $self->{message} = "SUCCESS: $update_query";
    return 1;

} # update_one_row

sub add_one_row {
    my $self = shift;
    my %args = (
	table=>'',
	add_values=>{},
	@_
    );

    my $table = $args{table};
    my %add_vals = %{$args{add_values}};
    my @columns = $self->get_colnames($table, do_rowid=>0);
    my $row_id_name = $self->get_id_colname($table);

    my $iquery = "INSERT INTO $table (";
    $iquery .= join(', ', @columns);
    $iquery .= ") VALUES (";
    my @vals = ();
    foreach my $col (@columns)
    {
	my $val = $add_vals{$col};
	if (!defined $val or $val eq 'NULL')
	{
	    push @vals, 'NULL';
	}
	elsif ($col eq $row_id_name)
	{
	    # if we are adding, this value needs to be null
	    push @vals, 'NULL';
	}
	else
	{
	    if ($self->col_is_int(table=>$table, column=>$col))
	    {
		push @vals, ($val ? $val : '0');
	    }
	    else
	    {
		# correct quotes
		push @vals, $self->{dbh}->quote($val);
	    }
	}
    }
    $iquery .= join(',', @vals);
    $iquery .= ")";
    
    # actual update
    my $rv = $self->{dbh}->do($iquery);
    if (!$rv)
    {
	$self->print_message("Can't execute insert $iquery: $DBI::errstr");
	return 0;
    }
    $self->{message} = "SUCCESS: " . $iquery;
    return 1;

} # add_one_row

sub delete_one_row {
    my $self = shift;
    my %args = (
	table=>'',
	row_id=>undef,
	@_
    );

    my $table = $args{table};
    my $row_id_name = $self->get_id_colname($table);
    my $row_id = $args{row_id};
    if (!$row_id)
    {
	$self->print_message("Can't delete from table $table: row-id $row_id_name is NULL");
	return 0;
    }
    my $dquery = "DELETE FROM $table WHERE $row_id_name = $row_id";
    
    # actual update
    my $rv = $self->{dbh}->do($dquery);
    if (!$rv)
    {
	$self->print_message("Can't execute update $dquery: $DBI::errstr");
	return 0;
    }
    $self->{message} = "SUCCESS: " . $dquery;
    return 1;

} # delete_one_row

sub do_import_fv {
    my $self = shift;
    my %args = (
	table=>'',
	datafile=>'',
	row_delim=>"=",
	@_
    );

    my $table = $args{table};
    my $row_delim = $args{row_delim};
    my $datafile = $args{datafile};

    if (!-r $datafile)
    {
	warn "cannot read $datafile";
	return 0;
    }
    my $fh;
    open($fh, $datafile)
	or die "cannot open $datafile";

    my $count = 0;
    # get the legal column names
    my @columns = $self->get_colnames($table,
	do_rowid=>0);
    my %legal_cols = ();
    foreach my $col (@columns)
    {
	$legal_cols{$col} = 1;
    }

    my %vals = ();
    my $cur_field;
    while (<$fh>)
    {
	chomp;
	if (/^$row_delim$/)
	{
	    if (!$self->add_one_row(table=>$table,
				  add_values=>\%vals))
	    {
		warn "failed to add row -- aborting\n";
		return 0;
	    }
	    $count++;
	    %vals = ();
	}
	elsif (/^(\w+):(.*)/)
	{
	    my $fn = $1;
	    my $v1 = $2;
	    if ($legal_cols{$fn})
	    {
		# is a new value
		$cur_field = $fn;
		$vals{$cur_field} = $v1;
	    }
	    else
	    {
		# is continuation
		$vals{$cur_field} .= "\n$_";
	    }
	}
	else
	{
	    $vals{$cur_field} .= "\n$_";
	}
    }
    return $count;

} # do_import_fv

sub print_message {
    my $self = shift;
    my $message = shift;
    my $is_error = (@_ ? shift : 1); # assume error message

    if ($is_error)
    {
	warn $message, "\n";
    }
    else
    {
	print $message, "\n";
    }
} # print_message

sub make_selections {
    my $self = shift;
    my %args = (
	table=>undef,
	command=>'Select',
	limit=>0,
	page=>1,
	table2=>'',
	headers=>[],
	groups=>[],
	sort_by=>[],
	sort_reversed=>{},
	not_where=>{},
	where=>{},
	show=>[],
	distinct=>0,
	layout=>'table',
	row_template=>'',
	outfile=>'',
	report_style=>'full',
	title=>'',
	prev_file=>'',
	next_file=>'',
	@_
    );
    my $table = $args{table};
    my $command = $args{command};

    my @sort_by = @{$args{sort_by}};
    my %sort_reversed = %{$args{sort_reversed}};
    my @columns = (@{$args{show}}
	? @{$args{show}}
	: $self->get_colnames($table));
    my $limit = $args{limit};
    my $page = $args{page};
    my $table2 = $args{table2};

    my $row_id_name = $self->get_id_colname($table);
    my $offset = $limit * ($page - 1);
    $offset = 0 if $offset < 0;

    # build up the query data
    my @where = $self->build_where_conditions(
	where=>$args{where}, not_where=>$args{not_where});
    
    my $jquery = '';
    my $join_col = $self->get_join_colname($table, $table2);
    $jquery = "SELECT DISTINCT $join_col FROM $table";
    my $query = "SELECT ";
    if (@columns)
    {
	$query .= "DISTINCT " if $args{distinct};
	$query .= join(", ", @columns);
    }
    else
    {
	$query .= "*";
    }
    $query .= " FROM $table";
    if (@where)
    {
	$query .= " WHERE " . join(" AND ", @where);
	$jquery .= " WHERE " . join(" AND ", @where);
    }
    if (@sort_by)
    {
	my @order_by = ();
	$query .= " ORDER BY ";
	$jquery .= " ORDER BY ";
	foreach my $col (@sort_by)
	{
	    if ($sort_reversed{$col})
	    {
		push @order_by, "$col DESC";
	    }
	    else
	    {
		push @order_by, $col;
	    }
	}
	$query .= join(', ', @order_by);
	$jquery .= join(', ', @order_by);
    }
    if ($limit)
    {
	$query .= " LIMIT $limit";
	$jquery .= " LIMIT $limit";
    }
    if ($offset)
    {
	$query .= " OFFSET $offset";
	$jquery .= " OFFSET $offset";
    }
    my $total = (defined $args{total}
	? $args{total}
	: $self->get_total_matching(%args));

    # actual query
    my $sth1;
    $sth1 = $self->{dbh}->prepare($query);
    if (!$sth1)
    {
	$self->print_message("Can't prepare query $query: $DBI::errstr");
	return 0;
    }
    my $rv = $sth1->execute();
    if (!$rv)
    {
	$self->print_message("Can't execute query $query: $DBI::errstr");
	return 0;
    }

    # make a "join-like" query of the second table
    # first figure out the correct value of the join field
    # then make the actual query
    my $sth2;
    my $t2query = '';
    if (($total == 1 or $limit == 1)
	and $table2)
    {
	my $sth_jq = $self->{dbh}->prepare($jquery);
	if (!$sth_jq)
	{
	    $self->print_message("Can't prepare query $jquery: $DBI::errstr");
	    return 0;
	}
	my $rv = $sth_jq->execute();
	if (!$rv)
	{
	    $self->print_message("Can't execute query $jquery: $DBI::errstr");
	    return 0;
	}
	my $join_val;
	my @row;
	while (@row = $sth_jq->fetchrow_array)
	{
	    $join_val = $row[0];
	}

	# make the query for the second table
	my @cols2 = $self->get_colnames($table2);
	$t2query = "SELECT ";
	$t2query .= join(', ', @cols2);
	$t2query .= " FROM $table2 ";
	if ($self->col_is_int(table=>$table2, column=>$join_col))
	{
	    $t2query .= "WHERE $join_col = $join_val";
	}
	else
	{
	    $t2query .= "WHERE $join_col = '$join_val'";
	}
	$sth2 = $self->{dbh}->prepare($t2query);
	if (!$sth2)
	{
	    $self->print_message("Can't prepare query $t2query: $DBI::errstr");
	    return 0;
	}
	$rv = $sth2->execute();
	if (!$rv)
	{
	    $self->print_message("Can't execute query $t2query: $DBI::errstr");
	    return 0;
	}
    }
    return ($sth1, $sth2);
} # make_selections

sub get_tables {
    my $self = shift;
    my %args = (
	views=>1,
	@_
    );

    my @tables = ();
    my $query = "SELECT name from sqlite_master ";
    if ($args{views})
    {
	$query .= "WHERE type = 'table' OR type = 'view'";
    }
    else
    {
	$query .= "WHERE type = 'table'";
    }
    my $sth = $self->{dbh}->prepare($query);
    if (!$sth)
    {
	$self->print_message("Can't prepare query $query: $DBI::errstr");
	return 0;
    }
    my $rv = $sth->execute();
    if (!$rv)
    {
	$self->print_message("Can't execute query $query: $DBI::errstr");
	return 0;
    }
    my @row;
    while (@row = $sth->fetchrow_array)
    {
	push @tables, $row[0];
    }
    return @tables;
} # get_tables

sub get_colnames {
    my $self = shift;
    my $table = shift;
    my %args = (
	do_rowid=>1,
	@_
    );

    my @columns = ($args{do_rowid}
	? ($self->get_id_colname($table) eq 'rowid' ? qw(rowid) : () )
	: ());
    my $query = "PRAGMA table_info('$table')";
    my $sth = $self->{dbh}->prepare($query);
    if (!$sth)
    {
	$self->print_message("Can't prepare query $query: $DBI::errstr");
	return 0;
    }
    my $rv = $sth->execute();
    if (!$rv)
    {
	$self->print_message("Can't execute query $query: $DBI::errstr");
	return 0;
    }
    my $row_hash;
    while ($row_hash = $sth->fetchrow_hashref)
    {
	push @columns, $row_hash->{'name'};
    }

    return @columns;
} # get_colnames

sub get_distinct_col {
    my $self = shift;
    my %args = (
	table=>undef,
	colname=>'',
	not_where=>{},
	where=>{},
	@_
    );
    my $table = $args{table};
    my $colname = $args{colname};

    # build up the query data
    my @where = $self->build_where_conditions(
	where=>$args{where}, not_where=>$args{not_where});
    
    my $query = "SELECT DISTINCT $colname FROM $table";
    if (@where)
    {
	$query .= " WHERE " . join(" AND ", @where);
    }
    $query .= " ORDER BY $colname";
    my $sth = $self->{dbh}->prepare($query);
    if (!$sth)
    {
	$self->print_message("Can't prepare query $query: $DBI::errstr");
	return 0;
    }
    my $rv = $sth->execute();
    if (!$rv)
    {
	$self->print_message("Can't execute query $query: $DBI::errstr");
	return 0;
    }
    my @vals = ();
    my @row;
    while (@row = $sth->fetchrow_array)
    {
	push @vals, $row[0];
    }
    return @vals;
} # get_distinct_col

sub print_select {
    my $self = shift;
    my $sth = shift;
    my $sth2 = shift;
    my %args = (
	table=>'',
	title=>'',
	command=>'Search',
	prev_file=>'',
	prev_label=>'Prev',
	next_file=>'',
	next_label=>'Next',
	@_
    );
    my @columns = @{$args{columns}};
    my @sort_by = @{$args{sort_by}};
    my $table = $args{table};
    my $page = $args{page};

    # read the template
    my $template = $self->get_template($self->{report_template});
    $self->{report_template} = $template;

    my $num_pages = ($args{limit} ? ceil($args{total} / $args{limit}) : 1);
    # generate the HTML table
    my $count = 0;
    my $res_tab = '';
    ($count, $res_tab) = $self->format_report($sth,
	%args,
	table=>$table,
	table2=>$args{table2},
	columns=>\@columns,
	sort_by=>\@sort_by,
	num_pages=>$num_pages,
	);
    my $main_title = ($args{title} ? $args{title}
	: "$table $args{command} result");
    my $title = ($args{limit} ? "$main_title ($page)"
	: $main_title);
    # fix up random apersands
    if ($title =~ / & /)
    {
	$title =~ s/ & / &amp; /g;
    }
    my @result = ();
    push @result, $res_tab;
    push @result, "<p>$count rows displayed of $args{total}.</p>\n"
	if ($args{report_style} ne 'bare'
	    and $args{report_style} ne 'compact');
    if ($args{limit} and $args{report_style} eq 'full')
    {
	push @result, "<p>Page $page of $num_pages.</p>\n"
    }
    if (defined $sth2)
    {
	my @cols2 = $self->get_colnames($args{table2});
	my $count2;
	my $tab2;
	($count2, $tab2) = $self->format_report($sth2,
						%args,
						table=>$args{table2},
						columns=>\@cols2,
						sort_by=>\@cols2,
						headers=>[],
						groups=>[],
						row_template=>'',
						num_pages=>0,
					       );
	if ($count2)
	{
	    push @result,<<EOT;
<h2>$args{table2}</h2>
$tab2
<p>$count2 rows displayed from $args{table2}.</p>
EOT
	}
    }

    # prepend the message
    unshift @result, "<p><i>$self->{message}</i></p>\n", if $self->{message};

    # append the prev-next links, if any
    my $prev_file = $args{prev_file};
    my $prev_label = $args{prev_label};
    my $next_file = $args{next_file};
    my $next_label = $args{next_label};
    if ($prev_file and $next_file)
    {
	push @result, "<hr/>\n";
	push @result, "<p><a href=\"$prev_file\">$prev_label</a> <a href=\"$next_file\">$next_label</a></p>\n";
    }
    elsif ($prev_file)
    {
	push @result, "<hr/>\n";
	push @result, "<p><a href=\"$prev_file\">$prev_label</a></p>\n";
    }
    elsif ($next_file)
    {
	push @result, "<hr/>\n";
	push @result, "<p><a href=\"$next_file\">$next_label</a></p>\n";
    }

    my $contents = join('', @result);
    my $out = $template;
    $out =~ s/<!--sqlr_title-->/$title/g;
    $out =~ s/<!--sqlr_contents-->/$contents/g;
    # Now print the page for the user to see...
    if (!defined $args{outfile} 
	or $args{outfile} eq ''
	or $args{outfile} eq '-')
    {
	print $out;
    }
    else
    {
	my $fh;
	open($fh, ">", $args{outfile})
	    or die "Could not open $args{outfile} for writing";
	print $fh $out;
	close($fh);
    }
} # print_select

sub get_template {
    my $self = shift;
    my $template = shift;

    if ($template !~ /\n/
	&& -r $template)
    {
	local $/ = undef;
	my $fh;
	open($fh, $template)
	    or die "Could not open ", $template;
	$template = <$fh>;
	close($fh);
    }
    return $template;
} # get_template

sub get_id_colname {
    my $self = shift;
    my $table = shift;

    if (exists $self->{row_ids}->{$table}
	and defined $self->{row_ids}->{$table})
    {
	return $self->{row_ids}->{$table};
    }
    return 'rowid';
} # get_id_colname

sub get_join_colname {
    my $self = shift;
    my $table = shift;
    my $table2 = shift;

    my $key1 = "$table+$table2";
    my $key2 = "$table2+$table";
    if (exists $self->{join_cols}->{$key1}
	and defined $self->{join_cols}->{$key1})
    {
	return $self->{join_cols}->{$key1};
    }
    elsif (exists $self->{join_cols}->{$key2}
	and defined $self->{join_cols}->{$key2})
    {
	return $self->{join_cols}->{$key2};
    }
    return 'rowid';
} # get_join_colname

sub col_is_int {
    my $self = shift;
    my %args = (
	table=>'',
	column=>'rowid',
	@_
    );
    my $table = $args{table};
    my $column = $args{column};

    my $query = "PRAGMA table_info('$table')";
    my $sth = $self->{dbh}->prepare($query);
    if (!$sth)
    {
	$self->print_message("Can't prepare query $query: $DBI::errstr");
	return 0;
    }
    my $rv = $sth->execute();
    if (!$rv)
    {
	$self->print_message("Can't execute query $query: $DBI::errstr");
	return 0;
    }
    my $row_hash;
    while ($row_hash = $sth->fetchrow_hashref)
    {
	if ($row_hash->{name} eq $column)
	{
	    if ($row_hash->{type} =~ /character/)
	    {
		return 0;
	    }
	    elsif ($row_hash->{type} =~ /integer/)
	    {
		return 1;
	    }
	    elsif ($row_hash->{type} =~ /smallint/)
	    {
		return 1;
	    }
	}
    }

    return 0;
} # col_is_int

sub format_report {
    my $self = shift;
    my $sth = shift;
    my %args = (
	table=>'',
	command=>'Search',
	layout=>'table',
	row_template=>'',
	report_style=>'full',
	table_header=>'',
	force_show_cols=>{},
	@_
    );
    my @columns = @{$args{columns}};
    my @sort_by = @{$args{sort_by}};
    my @headers = @{$args{headers}};
    my @groups = @{$args{groups}};
    my %force_show_cols = %{$args{force_show_cols}};
    my $command = $args{command};
    my $table = $args{table};
    my $table2 = $args{table2};
    my $report_style = $args{report_style};
    my $table_border = $args{table_border};
    my $truncate_colnames = $args{truncate_colnames};

    # change things depending on report_style
    if (!defined $table_border)
    {
	if ($report_style eq 'bare')
	{
	    $table_border = 0;
	}
	else
	{
	    $table_border = 1;
	}
    }
    if (!defined $truncate_colnames)
    {
	if ($report_style eq 'full')
	{
	    $truncate_colnames = 0;
	}
	elsif ($report_style eq 'medium')
	{
	    $truncate_colnames = 6;
	}
	elsif ($report_style eq 'compact')
	{
	    $truncate_colnames = 4;
	}
	else
	{
	    $truncate_colnames = 0;
	}
    }

    my @out = ();
    my $count = 0;
    my $row_id_name = $self->get_id_colname($table);
    my $row_id_ind;
    # by default, show all columns
    my %show_cols = ();
    for (my $i = 0; $i < @columns; $i++)
    {
	$show_cols{$columns[$i]} = 1;
	if ($columns[$i] eq $row_id_name)
	{
	    $row_id_ind = $i;
	}
    }

    # make headers for all the headers
    # set the headers and entry columns
    my %in_header = ();
    my %prev_head = ();
    if (@sort_by and @headers)
    {
	for (my $i=0; $i < @headers && $i < @sort_by; $i++)
	{
	    $prev_head{$i} = '';
	    # read each header template if it's a file
	    $headers[$i] = $self->get_template($headers[$i]);
	}
	# find out what fields are in the headers
	my $all_headers = join('', @headers);
	while ($all_headers =~ m/{\$(\w+)[:\w]*}/)
	{
	    $in_header{$1} = 1;
	    $all_headers =~ s/{\$\w+[:\w]*}//;
	}
	while ($all_headers =~ m/\[\$(\w+)[:\w]*\]/)
	{
	    $in_header{$1} = 1;
	    $all_headers =~ s/\[\$\w+[:\w]*\]//;
	}
	for my $col (@columns)
	{
	    if ($in_header{$col} && !$force_show_cols{$col})
	    {
		$show_cols{$col} = 0;
	    }
	}
	# read each 'group' template if the template is a file
	if (@groups)
	{
	    foreach my $group (@groups)
	    {
		$group = $self->get_template($group);
	    }
	}
    }
    #
    # Set the nicer column name labels
    my %nice_cols = $self->set_nice_cols(truncate_colnames=>$truncate_colnames,
	columns=>\@columns);

    my $row_template = $self->get_row_template(
	table=>$table,
	row_template=>$args{row_template},
	layout=>$args{layout},
	report_style=>$args{report_style},
	columns=>\@columns,
	show_cols=>\%show_cols,
	nice_cols=>\%nice_cols);
    my $thead = $self->get_template($args{table_header});
    if (%nice_cols and !$thead)
    {
	$thead .= '<thead><tr>';
	foreach my $col (@columns)
	{
	    if ($show_cols{$col})
	    {
		my $nicecol = $nice_cols{$col};
		$thead .= "<th>$nicecol</th>";
	    }
	}
	$thead .= "</tr></thead>\n";
    }

    my $page = ((defined $args{num_pages} and $args{num_pages} > 1)
	? $args{page} : 0);
    # process the rows
    my $new_section = 1;
    my $row_hash;
    while ($row_hash = $sth->fetchrow_hashref)
    {
	# add the page-number to the data
	$row_hash->{_page} = $page;
	$row_hash->{_num_pages} = $args{num_pages};
	if (@headers)
	{
	    for (my $hi = 0; $hi < @headers; $hi++)
	    {
		my $hval = $headers[$hi];
		$hval = '' if !$hval;
		$hval =~ s/{([^}]+)}/$self->{_tobj}->do_replace(data_hash=>$row_hash,targ=>$1)/eg;
		my $gval = $groups[$hi];
		$gval = '' if !$gval;
		$gval =~ s/{([^}]+)}/$self->{_tobj}->do_replace(data_hash=>$row_hash,targ=>$1)/eg;
		if ($hval
		    and $hval ne $prev_head{$hi})
		{
		    if ($count != 0 && !$new_section)
		    {
			push @out, $self->end_section(type=>$args{layout});
			$new_section = 1;
		    }
		    # only make a header if it has content
		    push @out, sprintf("<h%d>%s</h%d>\n",
				       $hi + 1, $hval, $hi + 1)
					if $hval;
		    # and group content, if there is any
		    push @out, "<p>$gval</p>\n", if $gval;
		    $prev_head{$hi} = $hval;
		}
	    }
	}
	if ($new_section)
	{
	    push @out, $self->start_section(type=>$args{layout},
					  table_border=>$table_border);
	    if ($report_style ne 'bare'
		and $args{layout} eq 'table')
	    {
		push @out, $thead;
	    }
	    $new_section = 0;
	}
	my $rowstr = $row_template;
	$rowstr =~ s/{([^}]+)}/$self->{_tobj}->do_replace(data_hash=>$row_hash,show_names=>\%show_cols,targ=>$1)/eg;
	push @out, $rowstr;
	$count++;
    } # for each row
    push @out, $self->end_section(type=>$args{layout});

    my $out_str = join('', @out);
    return ($count, $out_str);
} # format_report

sub get_row_template {
    my $self = shift;
    my %args = (
	table=>'',
	row_template=>'',
	layout=>'table',
	report_style=>'full',
	columns=>undef,
	show_cols=>undef,
	nice_cols=>undef,
	@_
    );

    my $row_template = $args{row_template};
    # read in the file if it's a file
    if ($row_template !~ /\n/ && -r $row_template)
    {
	my $fh;
	open($fh, $row_template)
	    or die "could not open $row_template: $!";
	local $/;
	$row_template = <$fh>;
	close($fh);
    }
    if (!$row_template)
    {
	my @rt = ();
	if ($args{layout} eq 'table')
	{
	    push @rt, "<tr>";
	    foreach my $col (@{$args{columns}})
	    {
		if ($args{show_cols}->{$col})
		{
		    push @rt, "<td>{?$col [\$$col";
		    push @rt, ':',
			$self->{default_format}->{$args{table}}->{$col}
			if ($self->{default_format}->{$args{table}}->{$col});
		    push @rt, "]!!&nbsp;}</td>\n";
		}
	    }
	    push @rt, "</tr>\n";
	}
	elsif ($args{layout} eq 'para')
	{
	    push @rt, "<p>";
	    foreach my $col (@{$args{columns}})
	    {
		if ($args{show_cols}->{$col})
		{
		    if ($args{report_style} ne 'bare')
		    {
			push @rt, "{?$col <strong>";
			push @rt, $args{nice_cols}->{$col};
			push @rt, ":</strong> ";
		    }
		    push @rt, "[\$";
		    push @rt, $col;
		    push @rt, ':',
			$self->{default_format}->{$args{table}}->{$col}
			if ($self->{default_format}->{$args{table}}->{$col});
		    push @rt, "]<br/>}\n";
		}
	    }
	    push @rt, "</p>\n";
	}
	elsif ($args{layout} eq 'list')
	{
	    push @rt, "<li>";
	    foreach my $col (@{$args{columns}})
	    {
		if ($args{show_cols}->{$col})
		{
		    push @rt, "{\$$col";
		    push @rt, ':',
			$self->{default_format}->{$args{table}}->{$col}
			if ($self->{default_format}->{$args{table}}->{$col});
		    push @rt, "}\n";
		}
	    }
	    push @rt, "</li>\n";
	}
	elsif ($args{layout} eq 'fieldval')
	{
	    # field:value
	    foreach my $col (@{$args{columns}})
	    {
		if ($args{show_cols}->{$col})
		{
		    push @rt, "$col:{\$$col";
		    push @rt, ':',
			$self->{default_format}->{$args{table}}->{$col}
			if ($self->{default_format}->{$args{table}}->{$col});
		    push @rt, "}\n";
		}
	    }
	    push @rt, "=\n";
	}
	elsif ($args{layout} eq '' or $args{layout} eq 'none')
	{
	    # one value on each line, no HTML
	    foreach my $col (@{$args{columns}})
	    {
		if ($args{show_cols}->{$col})
		{
		    push @rt, "{\$$col";
		    push @rt, ':',
			$self->{default_format}->{$args{table}}->{$col}
			if ($self->{default_format}->{$args{table}}->{$col});
		    push @rt, "}\n";
		}
	    }
	}
	$row_template = join('', @rt);
    }

    return $row_template;
} # get_row_template

sub set_nice_cols {
    my $self = shift;
    my %args = (
	columns=>[],
	truncate_colnames=>0,
	@_
    );
    my $truncate_colnames = $args{truncate_colnames};

    # Set the nicer column name labels
    my %nice_cols = ();
    foreach my $col (@{$args{columns}})
    {
	my $nicecol = $col;
	if ($truncate_colnames)
	{
	    my @colwords = split('_', $nicecol);
	    foreach my $cw (@colwords)
	    {
		$cw = $self->{_tobj}->convert_value(value=>$cw,
		    format=>"trunc${truncate_colnames}",
		    name=>$col);
		$cw = $self->{_tobj}->convert_value(value=>$cw,
		    format=>'proper',
		    name=>$col);
	    }
	    $nicecol = join(' ', @colwords);
	}
	else
	{
	    $nicecol =~ s/_/ /g;
	    $nicecol = $self->{_tobj}->convert_value(value=>$nicecol,
		format=>'proper', name=>$col);
	}
	$nice_cols{$col} = $nicecol;
    }
    return %nice_cols;
} # set_nice_cols

sub start_section {
    my $self = shift;
    my %args = (
	type=>'table',
	table_border=>1,
	@_
    );

    if ($args{type} eq 'table')
    {
	return '<table border="' . $args{table_border} . '" class="plain">';
    }
    elsif ($args{type} eq 'para')
    {
	return '';
    }
    elsif ($args{type} eq 'list')
    {
	return "<ul>\n";
    }
    '';
} # start_section

sub end_section {
    my $self = shift;
    my %args = (
	type=>'table',
	@_
    );

    if ($args{type} eq 'table')
    {
	return "</table>\n";
    }
    elsif ($args{type} eq 'para')
    {
	return "\n";
    }
    elsif ($args{type} eq 'list')
    {
	return "\n</ul>\n";
    }
    '';
} # end_section

sub build_where_conditions {
    my $self = shift;
    my %args = (
	not_where=>{},
	where=>{},
	@_
    );

    my @where = ();
    while (my ($col, $val) = each(%{$args{where}}))
    {
	if (!defined $val or $val eq 'NULL')
	{
	    if ($args{not_where}->{$col})
	    {
		push @where, "$col IS NOT NULL";
	    }
	    else
	    {
		push @where, "$col IS NULL";
	    }
	}
	elsif (!$val or $val eq "''")
	{
	    if ($args{not_where}->{$col})
	    {
		push @where, "$col != ''";
	    }
	    else
	    {
		push @where, "$col = ''";
	    }
	}
	else
	{
	    if ($args{not_where}->{$col})
	    {
		push @where, "$col NOT GLOB " . $self->{dbh}->quote($val);
	    }
	    else
	    {
		push @where, "$col GLOB " . $self->{dbh}->quote($val);
	    }
	}
    }
    return @where;
} # build_where_conditions

1; # End of SQLite::Work
__END__