File Coverage

blib/lib/Module/CoreList/DBSchema.pm

Criterion	Covered	Total	%
statement	62	64	96.8
branch	7	10	70.0
condition	7	10	70.0
subroutine	11	11	100.0
pod	5	5	100.0
total	92	100	92.0

package Module::CoreList::DBSchema;

use strict;
use warnings;
use Clone qw[clone];
use Module::CoreList;
use SQL::Abstract;
use vars qw[$VERSION];

$VERSION = '0.06';

my $tables = {
   cl_perls => [
      'perl_ver VARCHAR(20) NOT NULL',
      'released VARCHAR(10)',
    ],
    cl_versions => [
      'perl_ver VARCHAR(20) NOT NULL',
      'mod_name VARCHAR(300) NOT NULL',
      'mod_vers VARCHAR(30)',
      'deprecated BOOL',
    ],
    cl_families => [
      'perl_ver VARCHAR(20) NOT NULL',
      'family VARCHAR(20) NOT NULL',
    ],
    cl_upstream => [
      'mod_name VARCHAR(300) NOT NULL',
      'upstream VARCHAR(20)',
    ],
    cl_bugtracker => [
      'mod_name VARCHAR(300) NOT NULL',
      'url TEXT',
    ],
};

my $queries = {
  corelist => [ 'select cl_perls.perl_ver, mod_vers, released, deprecated from cl_versions,cl_perls where cl_perls.perl_ver = cl_versions.perl_ver and mod_name = ? order by cl_versions.perl_ver', 1 ],
};

my $sql = SQL::Abstract->new();

sub new {
  my $package = shift;
  my %opts = @_;
  $opts{lc $_} = delete $opts{$_} for keys %opts;
  my $self = bless \%opts, $package;
  return $self;
}

sub tables {
  my $clone = clone( $tables );
  return %{ $clone } if wantarray;
  return $clone;
}

sub data {
  my $self = shift;
  my %opts = @_;
  $opts{lc $_} = delete $opts{$_} for keys %opts;
  my $prefix = $opts{prefix} || '';
  my $data = [];
  foreach my $perl ( keys %Module::CoreList::version ) {
    push @{ $data }, [ $sql->insert( $prefix . 'cl_perls', [ $perl, $Module::CoreList::released{$perl} ] ) ];
    foreach my $mod ( keys %{ $Module::CoreList::version{ $perl } } ) {
      my $modver = $Module::CoreList::version{ $perl }{ $mod };
      $modver = '' unless $modver;
      my $deprecated = $Module::CoreList::deprecated{ $perl }{ $mod } || 0;
      push @{ $data }, [
        $sql->insert( $prefix . 'cl_versions', [ $perl, $mod, $modver, $deprecated ] )
      ];
    }
  }
  foreach my $family ( keys %Module::CoreList::families ) {
    push @{ $data }, [
      $sql->insert( $prefix . 'cl_families', [ $_, $family ] )
    ] for @{ $Module::CoreList::families{ $family } };
  }
  foreach my $mod ( keys %Module::CoreList::upstream ) {
    push @{ $data }, [
      $sql->insert( $prefix . 'cl_upstream', [ $mod, ( $Module::CoreList::upstream{ $mod } || '' ) ] )
    ];
  }
  foreach my $mod ( keys %Module::CoreList::bug_tracker ) {
    push @{ $data }, [
      $sql->insert( $prefix . 'cl_bugtracker', [ $mod, ( $Module::CoreList::bug_tracker{ $mod } || '' ) ] )
    ];
  }
  return @{ $data } if wantarray;
  return $data;
}

sub queries {
  return keys %{ $queries };
}

sub query {
  my $self = shift;
  my $query = shift || return;
  return unless exists $queries->{ $query };
  my $sql = $queries->{ $query };
  return @{ $sql } if wantarray;
  return $sql;
}

q[Modules are our business];

__END__