package SthFile;

use strict;
use warnings;

use Storable qw(store_fd fd_retrieve);
use IO::File;

use Data::Dumper;

=pod

=head1 Synopsis

  use SthFile;
  my $query = qq{ SELECT * FROM TABLE};
  my $sth = $dbh->prepare($query)
    or die "Cant prepare query: $query\n $DBI::errstr";
  $sth->execute()
    or die "Cant execute query: $query\n $DBI::errstr";

  SthFile::sth_to_file({
    sth => $sth,
    file_name => "/tmp/my_query.store",
  });

  # And later, in some other program or place

  my $sth_from_file = new SthFile("/tmp/my_query.store")
    or die "Cant get some garbage.";

=head1 Mimicing Stuff

This module makes an attempt to mimic the behaivors
of a statement handle as stated in the documentation.
fetchrow_array, fetchrow_arrayref, fetchrow_hashref,
fetchall_arrayref, fetchall_hashref have been implemented.
I'm aware those subs may be defined somewhere else and MAY
be written better, but it was fun to just write them.

=head1 Raison d'Etre

I wanted to take a query from a database and save it for later, withou
+t
having to modify it in some way in order to store it or worry about
how to store undefs.

=head1 To Dos

Have the ability to take a handle and write to that handle
as opposed to just writing to the filename specified.

Yeah, I threw in the 'active' stuff for fun.  Don't know
what to do with it.

I haven't fully tested fetchall_hashref or fetchall_arrayref.

=head1 Version 1

File format



  %meta_data (
    version => 1
    sth => { NAME => $sth->{NAME}
    sth_subs => { rows => $sth->rows()}
    rows => $sth->rows,
    maybe a date or the query or something.
  )
  \@data

=head1 Author

Martin VanWinkle (uber_spaced)


=cut

sub sth_to_file
{
    my ($param_ref) = @_;

    die "file_name must be specified"
        if ! $param_ref->{file_name};

    die "No sth given..."
        if ! $param_ref->{sth};

    
    my $fh = new IO::File ">$param_ref->{file_name}"
        or die "Cant open $param_ref->{file_name} for writing: $!";

    store_fd({
        sth => {
            NAME => $param_ref->{sth}->{NAME},
        },
        version => 1,
        sth_subs => {
            rows => $param_ref->{sth}->rows(),
        },
    }, $fh);
    
    store_sth_data($param_ref, $fh);
    
    $fh->close() or die "Couldnt close $param_ref->{file_name}: $!";
}

sub store_sth_data
{
    my ($param_ref, $fh) = @_;
    
    my $array_ref;
    while ($array_ref = $param_ref->{sth}->fetchrow_arrayref())
    {
        store_fd($array_ref,$fh);
    }
}

sub new
{
    my ($class, $file_name) = @_;

    my $fh = new IO::File "<$file_name"
        or die "Cant open $file_name for reading: $!";
    
    my $meta_ref = fd_retrieve($fh);
    
    die "Somethings wrong with , meta doesn't have version set..."
        if (!defined $meta_ref->{version});
    
    my $sth = $meta_ref->{sth};

    delete $meta_ref->{sth};
    
    $sth->{fh} = $fh;
    $sth->{meta_ref} = $meta_ref;
    $sth->{active} = 1;
    
    bless $sth;
    
    return $sth;
}

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

    $self->{fh}->close()
        if ($self->{active});
    $self->{active}    = 0;
}

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

    if (eof($self->{fh}))
    {
        $self->finish();
        return undef;
    }

    return fd_retrieve(
        $self->{fh}
    );
}

sub fetchrow_array
{
    my ($self) = @_;
    
    my $ar = $self->fetchrow_arrayref();
    return @{$ar} if defined $ar;
    return ();
}

sub fetchrow_hashref
{
    my ($self) = @_;
    
    my %hash;
    my @array = $self->fetchrow_array();

    @hash{
        @{$self->{NAME}}
    } = @array;

    return \%hash if scalar(@array);
    return undef;
}

sub fetchall_arrayref
{
    my ($self, $slice, $max_rows ) = @_;

    my $row_count = 0;
    my $ar = [];
    my $thing_to_push;

    while (
        $thing_to_push = $self->fetchall_arrayref_helper($slice)
    )
    {
        last if (defined $max_rows && $row_count < $max_rows);
        
        $row_count++;
        push @$ar, $thing_to_push
    }
    return $ar;

}

sub fetchall_arrayref_helper
{
    my ($self, $slice) = @_;
    if (ref($slice) eq 'HASH')
    {
        my $hr = $self->fetchrow_hashref();
        return undef if !defined $hr;
        
        if (! scalar(keys %$slice))
        {
            return $hr;
        }
        else
        {
            my %i_hash;
            @i_hash{keys %$slice} = 
                @{%$hr}{keys %$slice};
            return \%i_hash;
        }
    }
    elsif (ref($slice) eq 'ARRAY' || !$slice)
    {
        my $ar = $self->fetchrow_arrayref();
        return undef if !defined $ar;
        
        if (! scalar(@$slice))
        {
            return $ar;
        }
        else
        {
            my @sliced = @$ar[@$slice];
            return \@sliced;
        }
    }
    else {
        die "I have no idea what you want me to do.";
    }
}

sub fetchall_hashref
{
    my ( $self, $key_field ) = @_;
    
    die "2nd arg to fetchall_hashref must be a field to key on."
        if (!defined $key_field);
        
    my %hash;
    
    my $hr;
    while ($hr = $self->fetchrow_hashref())
    {
        $hash{$hr->{$key_field}} = $hr;
    }
    
    return \%hash;
}

sub rows
{
    my ($self) = @_;
    return $self->{meta_ref}{sth_subs}->{rows};
}

1;
[download]