The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package SQL::Library;

use strict;
use warnings;

our $VERSION = 0.0.3;

=head1 NAME

SQL::Library - A module for managing simple SQL libraries
stored in INI-like files.

=head1 VERSION

This document refers to version 0.0.3 of SQL::Library.

=head1 SYNOPSIS

  use SQL::Library;
    
  my $sql = new SQL::Library { lib => 'sql.lib' };
                        # or { lib => [ <FH> ] };
                        # or { lib => [ $string ] };

  ## Ask for a library entry by name...
  my $query = $sql->retr( 'some_sql_query' );

  ## Add or update an entry...
  $sql->set( 'yet_another_query', <<'END' );
  SELECT foo
  FROM   bar
  WHERE  zoot = 1
  END

  ## Remove an entry from the library...
  $sql->drop( 'one_more_query' );

  ## List the entries in the library...
  print join( ' : ', $sql->elements ), "\n";

  ## Dump the contents of the library to a string...
  my $lib_str = $sql->dump;

  ## Write the library to disk...
  $sql->write;

=head1 LIBRARY FILE FORMAT

The format for the library files looks a little like an INI file.
However, unlike an INI file, it does not handle key=value pairs
which are divided into sections.  Library entry names are on a line by
themselves, enclosed in square brackets.  Whatever occurs until the
next title tag is the value of the library entry.  Blank lines, pound
signs (#) and C++ style comments (//) are all discarded.

A sample library file might look like this:

  ## A sample library file

  [get_survey_questions]
  select   question_no,
           question_text
  from     question
  where    survey_id = ?
  order by question_no

  [get_survey_info]
  select title,
         date_format( open_date, '%Y%m%d' ) as open_date, 
         date_format( close_date, '%Y%m%d' ) as close_date, 
         template_file
  from   survey
  where  survey_id = ?

=head1 OBJECT METHODS

=over 4

=item PACKAGE-E<gt>new( HASHREF )

Create a new library handle.  Currently, the only argument supported in
the hashref is C<lib>, which refers to the file containing the SQL
library.

=cut

sub new
{
    my $proto = shift; 
    my $options = shift;
    my $self = {
                 'options'  => $options,
                 'contents' => undef
               };

    my $curr_name = '';

    my @lib_arr = ();
    if ( ref $self->{'options'}->{'lib'} eq 'ARRAY' )
    {
        # Could be a filehandle or a string.
        if ( @{ $self->{'options'}->{'lib'} } == 1 )
        {
            @lib_arr = split /(?<=\n)/, $self->{'options'}->{'lib'}->[0];
        }
        else
        {
            @lib_arr = @{ $self->{'options'}->{'lib'} };
        }
    }
    else
    {
        open LIB, $self->{'options'}->{'lib'}
          or die "Cannot open $self->{'options'}->{'lib'}: $!";
        @lib_arr = <LIB>;
        close LIB;
    }

    foreach ( @lib_arr )
    {
        next if m{^\s*$};
        next if m{^\s*#};
        next if m{^\s*//};
        if ( m{^\[([^\]]+)\]} )
        {
            $curr_name = $1;
            next;
        }
        if ( $curr_name )
        {
            $self->{'contents'}->{$curr_name} .= $_;
        }
    }

    bless $self, $proto;
    return $self;
}

=item $OBJ-E<gt>retr( NAME )

Returns the library entry referenced by NAME.

=cut 

sub retr
{
    my ( $self, $entity_name ) = @_;
    return $self->{'contents'}->{$entity_name};
}

=item $OBJ-E<gt>set( NAME, VALUE )

Sets the library entry NAME to VALUE.  This is used both to create new
library entries and to update existing ones.

=cut

sub set
{
    my ( $self, $entity_name, $entity ) = @_;
    $self->{'contents'}->{$entity_name} = $entity;
    return $self;
}

=item $OBJ-E<gt>drop( NAME )

Drops entry NAME form the library.

=cut

sub drop
{
    my ( $self, $entity_name ) = @_;
    delete $self->{'contents'}->{$entity_name};
    return $self;
}

=item $OBJ-E<gt>elements

Returns a list of all entry names in the library.

=cut 

sub elements
{
    my $self = shift;
    return sort keys %{$self->{'contents'}};
}

=item $OBJ-E<gt>dump

Returns a string containing the library contents in the same
INI format that the module reads from.

=cut 

sub dump
{
    my $self   = shift;
    my $output = '';
    foreach ( sort keys %{$self->{'contents'}} )
    {
        $output .= sprintf "[%s]\n%s\n", $_, $self->{'contents'}->{$_};
    }
    return $output;
}

=item $OBJ-E<gt>write

Writes the library to the file named in C<lib>.

=cut

sub write
{
    my $self = shift;
    open OUT, ">$self->{'options'}->{'lib'}"
      or die "Cannot open $self->{'options'}->{'lib'}: $!";
    print OUT $self->dump;
    close OUT;
}

=back

=head1 AUTHOR

Doug Gorley E<lt>douggorley@shaw.caE<gt>

=head1 BUGS

=over 4

=item *

write() should write to a string, if it was so called.

=back

=head1 TO-DO

=over 4

=item *

Complete test suite

=back

=head1 COPYRIGHT

Copyright (C) 2004 by Doug Gorley.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=cut

1 ;

__END__