cut script into smaller pieces, since it becomes hard to manage
This commit is contained in:
espie
parent
b4f993a231
commit
309f80f5b3
185
databases/sqlports/files/Column.pm
Normal file
185
databases/sqlports/files/Column.pm
Normal file
@ -0,0 +1,185 @@
|
||||
#! /usr/bin/perl
|
||||
# $OpenBSD: Column.pm,v 1.1 2010/04/13 10:23:53 espie Exp $
|
||||
#
|
||||
# Copyright (c) 2006-2010 Marc Espie <espie@openbsd.org>
|
||||
#
|
||||
# Permission to use, copy, modify, and distribute this software for any
|
||||
# purpose with or without fee is hereby granted, provided that the above
|
||||
# copyright notice and this permission notice appear in all copies.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package Column;
|
||||
sub new
|
||||
{
|
||||
my ($class, $name) = @_;
|
||||
if (!defined $name) {
|
||||
$name = $class->default_name;
|
||||
}
|
||||
bless {name => $name}, $class;
|
||||
}
|
||||
|
||||
sub set_class
|
||||
{
|
||||
my ($self, $varclass) = @_;
|
||||
|
||||
$self->{class} = $varclass;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub name
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{name};
|
||||
}
|
||||
|
||||
sub render
|
||||
{
|
||||
my ($self, $inserter, $class) = @_;
|
||||
return $self->name." ".$self->sqltype;
|
||||
}
|
||||
|
||||
sub render_view
|
||||
{
|
||||
my ($self, $t) = @_;
|
||||
return $t.".".$self->name." AS ".$self->name;
|
||||
}
|
||||
|
||||
sub render_join
|
||||
{
|
||||
return "";
|
||||
}
|
||||
|
||||
package TextColumn;
|
||||
our @ISA = qw(Column);
|
||||
|
||||
sub sqltype
|
||||
{
|
||||
return "TEXT NOT NULL";
|
||||
}
|
||||
|
||||
package OptTextColumn;
|
||||
our @ISA = qw(TextColumn);
|
||||
|
||||
sub sqltype
|
||||
{
|
||||
return "TEXT";
|
||||
}
|
||||
|
||||
package IntegerColumn;
|
||||
our @ISA =qw(Column);
|
||||
sub sqltype
|
||||
{
|
||||
return "INTEGER NOT NULL";
|
||||
}
|
||||
|
||||
package OptIntegerColumn;
|
||||
our @ISA = qw(IntegerColumn);
|
||||
sub sqltype
|
||||
{
|
||||
return "INTEGER";
|
||||
}
|
||||
|
||||
package RefColumn;
|
||||
our @ISA = qw(Column);
|
||||
|
||||
my $table = "T0001";
|
||||
|
||||
sub table
|
||||
{
|
||||
my $self = shift;
|
||||
if (!defined $self->{table}) {
|
||||
$self->{table} = $table++;
|
||||
}
|
||||
return $self->{table};
|
||||
}
|
||||
|
||||
package PathColumn;
|
||||
our @ISA = qw(RefColumn);
|
||||
|
||||
sub default_name
|
||||
{
|
||||
return "FULLPKGPATH";
|
||||
}
|
||||
|
||||
sub render_view
|
||||
{
|
||||
my ($self, $t) = @_;
|
||||
return $self->table.".FULLPKGPATH AS ".$self->name;
|
||||
}
|
||||
|
||||
sub render
|
||||
{
|
||||
my ($self, $inserter, $class) = @_;
|
||||
return $inserter->pathref($self->name);
|
||||
}
|
||||
|
||||
sub render_join
|
||||
{
|
||||
my ($self, $table) = @_;
|
||||
return "JOIN Paths ".$self->{table}." ON ".$self->table.".ID=$table.".$self->name;
|
||||
}
|
||||
|
||||
package ValueColumn;
|
||||
our @ISA = qw(RefColumn);
|
||||
|
||||
sub default_name
|
||||
{
|
||||
return "VALUE";
|
||||
}
|
||||
|
||||
sub k
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{class}->keyword_table;
|
||||
}
|
||||
|
||||
sub render
|
||||
{
|
||||
my ($self, $inserter) = @_;
|
||||
return $inserter->value($self->k, $self->name);
|
||||
}
|
||||
|
||||
sub render_view
|
||||
{
|
||||
my ($self, $t) = @_;
|
||||
if (defined $self->k) {
|
||||
return $self->table.".VALUE AS ".$self->name;
|
||||
} else {
|
||||
return $self->SUPER::render_view($t);
|
||||
}
|
||||
}
|
||||
|
||||
sub render_join
|
||||
{
|
||||
my ($self, $table) = @_;
|
||||
if (defined $self->k) {
|
||||
return "JOIN ".$self->k." ".$self->table." ON ".$self->table.".KEYREF=$table.".$self->name;
|
||||
}
|
||||
}
|
||||
|
||||
package OptValueColumn;
|
||||
our @ISA = qw(ValueColumn);
|
||||
|
||||
sub render
|
||||
{
|
||||
my ($self, $inserter) = @_;
|
||||
return $inserter->optvalue($self->k, $self->name);
|
||||
}
|
||||
|
||||
sub render_join
|
||||
{
|
||||
my ($self, $table) = @_;
|
||||
return "LEFT ".$self->SUPER::render_join($table);
|
||||
}
|
||||
|
||||
1;
|
||||
396
databases/sqlports/files/Inserter.pm
Normal file
396
databases/sqlports/files/Inserter.pm
Normal file
@ -0,0 +1,396 @@
|
||||
#! /usr/bin/perl
|
||||
# $OpenBSD: Inserter.pm,v 1.1 2010/04/13 10:23:53 espie Exp $
|
||||
#
|
||||
# Copyright (c) 2006-2010 Marc Espie <espie@openbsd.org>
|
||||
#
|
||||
# Permission to use, copy, modify, and distribute this software for any
|
||||
# purpose with or without fee is hereby granted, provided that the above
|
||||
# copyright notice and this permission notice appear in all copies.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package AbstractInserter;
|
||||
# this is the object to use to put stuff into the db...
|
||||
sub new
|
||||
{
|
||||
my ($class, $db, $i) = @_;
|
||||
bless {
|
||||
db => $db,
|
||||
transaction => 0,
|
||||
threshold => $i,
|
||||
vars => {},
|
||||
tables_created => {}
|
||||
}, $class;
|
||||
}
|
||||
|
||||
sub make_table
|
||||
{
|
||||
my ($self, $class, $constraint, @columns) = @_;
|
||||
|
||||
return if defined $self->{tables_created}->{$class->table};
|
||||
|
||||
unshift(@columns, PathColumn->new);
|
||||
for my $c (@columns) {
|
||||
$c->set_class($class) unless defined $c->{class};
|
||||
}
|
||||
my @l = map {$_->render($self)} @columns;
|
||||
push(@l, $constraint) if defined $constraint;
|
||||
$self->new_table($class->table, @l);
|
||||
}
|
||||
|
||||
sub set
|
||||
{
|
||||
my ($self, $ref) = @_;
|
||||
$self->{ref} = $ref;
|
||||
}
|
||||
|
||||
sub db
|
||||
{
|
||||
return shift->{db};
|
||||
}
|
||||
|
||||
sub last_id
|
||||
{
|
||||
return shift->db->func('last_insert_rowid');
|
||||
}
|
||||
|
||||
sub insert_done
|
||||
{
|
||||
my $self = shift;
|
||||
if ($self->{transaction}++ % $self->{threshold} == 0) {
|
||||
$self->db->commit;
|
||||
}
|
||||
}
|
||||
|
||||
sub new_table
|
||||
{
|
||||
my ($self, $name, @cols) = @_;
|
||||
|
||||
return if defined $self->{tables_created}->{$name};
|
||||
|
||||
$self->db->do("DROP TABLE IF EXISTS $name");
|
||||
print "CREATE TABLE $name (".join(', ', @cols).")\n" if $main::opt_v;
|
||||
$self->db->do("CREATE TABLE $name (".join(', ', @cols).")");
|
||||
$self->{tables_created}->{$name} = 1;
|
||||
}
|
||||
|
||||
sub prepare
|
||||
{
|
||||
my ($self, $s) = @_;
|
||||
return $self->db->prepare($s);
|
||||
}
|
||||
|
||||
sub prepare_inserter
|
||||
{
|
||||
my ($ins, $table, @cols) = @_;
|
||||
$ins->{insert}->{$table} = $ins->prepare(
|
||||
"INSERT OR REPLACE INTO $table (".
|
||||
join(', ', @cols).
|
||||
") VALUES (".
|
||||
join(', ', map {'?'} @cols).")");
|
||||
}
|
||||
|
||||
sub prepare_normal_inserter
|
||||
{
|
||||
my ($ins, $table, @cols) = @_;
|
||||
$ins->prepare_inserter($table, "FULLPKGPATH", @cols);
|
||||
}
|
||||
|
||||
sub finish_port
|
||||
{
|
||||
my $self = shift;
|
||||
my @values = ($self->ref);
|
||||
for my $i (@{$self->{varlist}}) {
|
||||
push(@values, $self->{vars}->{$i});
|
||||
}
|
||||
$self->insert('Ports', @values);
|
||||
$self->{vars} = {};
|
||||
}
|
||||
|
||||
sub add_to_port
|
||||
{
|
||||
my ($self, $var, $value) = @_;
|
||||
$self->{vars}->{$var} = $value;
|
||||
}
|
||||
|
||||
sub create_tables
|
||||
{
|
||||
my ($self, $vars) = @_;
|
||||
|
||||
$self->db->commit;
|
||||
my @columns = sort {$a->name cmp $b->name} @{$self->{columnlist}};
|
||||
unshift(@columns, PathColumn->new);
|
||||
my @l = map {$_->render($self)} @columns;
|
||||
$self->new_table("Ports", @l, "UNIQUE(FULLPKGPATH)");
|
||||
$self->prepare_normal_inserter('Ports', @{$self->{varlist}});
|
||||
$self->prepare_normal_inserter('Paths', 'PKGPATH');
|
||||
}
|
||||
|
||||
sub ref
|
||||
{
|
||||
return shift->{ref};
|
||||
}
|
||||
|
||||
sub insert
|
||||
{
|
||||
my $self = shift;
|
||||
my $table = shift;
|
||||
$self->{insert}->{$table}->execute(@_);
|
||||
$self->insert_done;
|
||||
}
|
||||
|
||||
package CompactInserter;
|
||||
our @ISA=(qw(AbstractInserter));
|
||||
|
||||
our $c = {
|
||||
Library => 0,
|
||||
Run => 1,
|
||||
Build => 2,
|
||||
Regress => 3
|
||||
};
|
||||
|
||||
sub convert_depends
|
||||
{
|
||||
my ($self, $value) = @_;
|
||||
return $c->{$value};
|
||||
}
|
||||
|
||||
|
||||
sub pathref
|
||||
{
|
||||
my ($self, $name) = @_;
|
||||
$name = "FULLPKGPATH" if !defined $name;
|
||||
return "$name INTEGER NOT NULL REFERENCES Paths(ID)";
|
||||
}
|
||||
|
||||
sub value
|
||||
{
|
||||
my ($self, $k, $name) = @_;
|
||||
$name = "VALUE" if !defined $name;
|
||||
if (defined $k) {
|
||||
return "$name INTEGER NOT NULL REFERENCES $k(KEYREF)";
|
||||
} else {
|
||||
return "$name TEXT NOT NULL";
|
||||
}
|
||||
}
|
||||
|
||||
sub optvalue
|
||||
{
|
||||
my ($self, $k, $name) = @_;
|
||||
$name = "VALUE" if !defined $name;
|
||||
if (defined $k) {
|
||||
return "$name INTEGER REFERENCES $k(KEYREF)";
|
||||
} else {
|
||||
return "$name TEXT";
|
||||
}
|
||||
}
|
||||
|
||||
sub create_view
|
||||
{
|
||||
my ($self, $table, @columns) = @_;
|
||||
|
||||
unshift(@columns, PathColumn->new);
|
||||
my $name = "_$table";
|
||||
my @l = map {$_->render_view($table) } @columns;
|
||||
my @j = map {$_->render_join($table)} @columns;
|
||||
my $v = "CREATE VIEW $name AS SELECT ".join(", ", @l). " FROM ".$table.' '.join(' ', @j);
|
||||
$self->db->do("DROP VIEW IF EXISTS $name");
|
||||
print "$v\n" if $main::opt_v;
|
||||
$self->db->do($v);
|
||||
}
|
||||
|
||||
sub make_table
|
||||
{
|
||||
my ($self, $class, $constraint, @columns) = @_;
|
||||
|
||||
return if defined $self->{tables_created}->{$class->table};
|
||||
|
||||
$self->SUPER::make_table($class, $constraint, @columns);
|
||||
$self->create_view($class->table, @columns);
|
||||
}
|
||||
|
||||
sub create_tables
|
||||
{
|
||||
my ($self, $vars) = @_;
|
||||
# create the various tables, dropping old versions
|
||||
|
||||
$self->new_table("Paths", "ID INTEGER PRIMARY KEY",
|
||||
"FULLPKGPATH TEXT NOT NULL UNIQUE", "PKGPATH INTEGER");
|
||||
|
||||
while (my ($name, $class) = each %$vars) {
|
||||
my $c = $class->column($name);
|
||||
if (!defined( $class->table )) {
|
||||
push(@{$self->{varlist}}, $name);
|
||||
push(@{$self->{columnlist}}, $c);
|
||||
}
|
||||
$class->create_table($self);
|
||||
}
|
||||
|
||||
$self->SUPER::create_tables($vars);
|
||||
my @columns = sort {$a->name cmp $b->name} @{$self->{columnlist}};
|
||||
$self->create_view("Ports", @columns);
|
||||
$self->{find_pathkey} =
|
||||
$self->prepare("SELECT ID From Paths WHERE FULLPKGPATH=(?)");
|
||||
}
|
||||
|
||||
sub find_pathkey
|
||||
{
|
||||
my ($self, $key) = @_;
|
||||
|
||||
if (!defined $key or $key eq '') {
|
||||
print STDERR "Empty pathkey\n";
|
||||
return 0;
|
||||
}
|
||||
|
||||
# get pathkey for existing value
|
||||
$self->{find_pathkey}->execute($key);
|
||||
my $z = $self->{find_pathkey}->fetchrow_arrayref;
|
||||
if (!defined $z) {
|
||||
# if none, we create one
|
||||
my $path = $key;
|
||||
$path =~ s/\,.*//;
|
||||
if ($path ne $key) {
|
||||
$path = $self->find_pathkey($path);
|
||||
} else {
|
||||
$path = undef;
|
||||
}
|
||||
$self->insert('Paths', $key, $path);
|
||||
return $self->last_id;
|
||||
} else {
|
||||
return $z->[0];
|
||||
}
|
||||
}
|
||||
|
||||
sub set_newkey
|
||||
{
|
||||
my ($self, $key) = @_;
|
||||
|
||||
$self->set($self->find_pathkey($key));
|
||||
}
|
||||
|
||||
sub find_keyword_id
|
||||
{
|
||||
my ($self, $key, $t) = @_;
|
||||
$self->{$t}->{find_key1}->execute($key);
|
||||
my $a = $self->{$t}->{find_key1}->fetchrow_arrayref;
|
||||
if (!defined $a) {
|
||||
$self->{$t}->{find_key2}->execute($key);
|
||||
$self->insert_done;
|
||||
return $self->last_id;
|
||||
} else {
|
||||
return $a->[0];
|
||||
}
|
||||
}
|
||||
|
||||
sub create_keyword_table
|
||||
{
|
||||
my ($self, $t) = @_;
|
||||
$self->new_table($t,
|
||||
"KEYREF INTEGER PRIMARY KEY AUTOINCREMENT",
|
||||
"VALUE TEXT NOT NULL UNIQUE");
|
||||
$self->{$t}->{find_key1} = $self->prepare("SELECT KEYREF FROM $t WHERE VALUE=(?)");
|
||||
$self->{$t}->{find_key2} = $self->prepare("INSERT INTO $t (VALUE) VALUES (?)");
|
||||
}
|
||||
|
||||
package NormalInserter;
|
||||
our @ISA=(qw(AbstractInserter));
|
||||
|
||||
our $c = {
|
||||
Library => 'L',
|
||||
Run => 'R',
|
||||
Build => 'B',
|
||||
Regress => 'Regress'
|
||||
};
|
||||
|
||||
sub convert_depends
|
||||
{
|
||||
my ($self, $value) = @_;
|
||||
return $c->{$value};
|
||||
}
|
||||
|
||||
sub create_tables
|
||||
{
|
||||
my ($self, $vars) = @_;
|
||||
# create the various tables, dropping old versions
|
||||
|
||||
$self->new_table("Paths", "FULLPKGPATH TEXT NOT NULL PRIMARY KEY",
|
||||
"PKGPATH TEXT NOT NULL");
|
||||
while (my ($name, $class) = each %$vars) {
|
||||
push(@{$self->{varlist}}, $name);
|
||||
push(@{$self->{columnlist}}, $class->column($name));
|
||||
$class->create_table($self);
|
||||
}
|
||||
|
||||
$self->SUPER::create_tables($vars);
|
||||
|
||||
}
|
||||
|
||||
sub pathref
|
||||
{
|
||||
my ($self, $name) = @_;
|
||||
$name = "FULLPKGPATH" if !defined $name;
|
||||
return "$name TEXT NOT NULL";
|
||||
}
|
||||
|
||||
sub value
|
||||
{
|
||||
my ($self, $k, $name) = @_;
|
||||
$name = "VALUE" if !defined $name;
|
||||
return "$name TEXT NOT NULL";
|
||||
}
|
||||
|
||||
sub optvalue
|
||||
{
|
||||
my ($self, $k, $name) = @_;
|
||||
$name = "VALUE" if !defined $name;
|
||||
return "$name TEXT";
|
||||
}
|
||||
|
||||
sub key
|
||||
{
|
||||
return "TEXT NOT NULL";
|
||||
}
|
||||
|
||||
sub optkey
|
||||
{
|
||||
return "TEXT";
|
||||
}
|
||||
|
||||
sub set_newkey
|
||||
{
|
||||
my ($self, $key) = @_;
|
||||
|
||||
my $path = $key;
|
||||
$path =~ s/\,.*//;
|
||||
$self->insert('Paths', $key, $path);
|
||||
$self->set($key);
|
||||
}
|
||||
|
||||
sub find_pathkey
|
||||
{
|
||||
my ($self, $key) = @_;
|
||||
|
||||
return $key;
|
||||
}
|
||||
|
||||
# no keyword for this dude
|
||||
sub find_keyword_id
|
||||
{
|
||||
my ($self, $key, $t) = @_;
|
||||
return $key;
|
||||
}
|
||||
|
||||
sub create_keyword_table
|
||||
{
|
||||
}
|
||||
|
||||
1;
|
||||
529
databases/sqlports/files/Var.pm
Normal file
529
databases/sqlports/files/Var.pm
Normal file
@ -0,0 +1,529 @@
|
||||
#! /usr/bin/perl
|
||||
# $OpenBSD: Var.pm,v 1.1 2010/04/13 10:23:53 espie Exp $
|
||||
#
|
||||
# Copyright (c) 2006-2010 Marc Espie <espie@openbsd.org>
|
||||
#
|
||||
# Permission to use, copy, modify, and distribute this software for any
|
||||
# purpose with or without fee is hereby granted, provided that the above
|
||||
# copyright notice and this permission notice appear in all copies.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use subs qw(main::words);
|
||||
# use a Template Method approach to store the variable values.
|
||||
|
||||
# rule: we store each value in the main table, after converting YesNo
|
||||
# variables to undef/1. Then, in addition, we process specific variables
|
||||
# to store them in secondary tables (because of one/many associations).
|
||||
|
||||
package AnyVar;
|
||||
sub new
|
||||
{
|
||||
my ($class, $var, $value) = @_;
|
||||
bless [$var, $value], $class;
|
||||
}
|
||||
|
||||
sub var
|
||||
{
|
||||
return shift->[0];
|
||||
}
|
||||
|
||||
sub value
|
||||
{
|
||||
return shift->[1];
|
||||
}
|
||||
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
$ins->add_to_port($self->var, $self->value);
|
||||
}
|
||||
|
||||
sub add_value
|
||||
{
|
||||
my ($self, $ins, $value) = @_;
|
||||
$ins->add_to_port($self->var, $value);
|
||||
}
|
||||
|
||||
sub column
|
||||
{
|
||||
my ($self, $name) = @_;
|
||||
return $self->columntype->new($name)->set_class($self);
|
||||
}
|
||||
|
||||
sub columntype
|
||||
{
|
||||
return 'OptTextColumn';
|
||||
}
|
||||
|
||||
sub table()
|
||||
{
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub keyword_table()
|
||||
{
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub keyword
|
||||
{
|
||||
my ($self, $ins, $value) = @_;
|
||||
return $ins->find_keyword_id($value, $self->keyword_table);
|
||||
}
|
||||
|
||||
sub create_keyword_table
|
||||
{
|
||||
my ($self, $inserter) = @_;
|
||||
if (defined $self->keyword_table) {
|
||||
$inserter->create_keyword_table($self->keyword_table);
|
||||
}
|
||||
}
|
||||
|
||||
sub create_table
|
||||
{
|
||||
my ($self, $inserter) = @_;
|
||||
$self->create_keyword_table($inserter);
|
||||
}
|
||||
|
||||
sub insert
|
||||
{
|
||||
my $self = shift;
|
||||
my $ins = shift;
|
||||
$ins->insert($self->table, @_);
|
||||
}
|
||||
|
||||
sub normal_insert
|
||||
{
|
||||
my $self = shift;
|
||||
my $ins = shift;
|
||||
$ins->insert($self->table, $ins->ref, @_);
|
||||
}
|
||||
|
||||
package KeyVar;
|
||||
our @ISA=(qw(AnyVar));
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
$self->add_value($ins, $self->keyword($ins, $self->value));
|
||||
}
|
||||
|
||||
sub columntype
|
||||
{
|
||||
return 'ValueColumn';
|
||||
}
|
||||
|
||||
package ArchKeyVar;
|
||||
our @ISA=(qw(KeyVar));
|
||||
|
||||
sub keyword_table()
|
||||
{ 'Arch' }
|
||||
|
||||
package OptKeyVar;
|
||||
our @ISA=(qw(KeyVar));
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
if ($self->value ne '') {
|
||||
$self->SUPER::add($ins);
|
||||
}
|
||||
}
|
||||
|
||||
sub columntype
|
||||
{
|
||||
return 'OptValueColumn';
|
||||
}
|
||||
|
||||
package YesNoVar;
|
||||
our @ISA=(qw(AnyVar));
|
||||
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
$self->add_value($ins, $self->value =~ m/^Yes/i ? 1 : undef);
|
||||
}
|
||||
|
||||
sub columntype
|
||||
{
|
||||
return 'OptIntegerColumn';
|
||||
}
|
||||
|
||||
# variable is always defined, but we don't need to store empty values.
|
||||
package DefinedVar;
|
||||
our @ISA=(qw(AnyVar));
|
||||
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
return if $self->value eq '';
|
||||
$self->SUPER::add($ins);
|
||||
}
|
||||
|
||||
|
||||
# all the dependencies are converted into list. Stuff like LIB_DEPENDS will
|
||||
# end up being treated as WANTLIB as well.
|
||||
|
||||
package DependsVar;
|
||||
our @ISA=(qw(AnyVar));
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
$self->SUPER::add($ins);
|
||||
for my $depends (main::words $self->value) {
|
||||
my ($libs, $pkgspec, $pkgpath2, $rest) = split(/\:/, $depends);
|
||||
if (!defined $pkgpath2) {
|
||||
print STDERR "Wrong depends $depends\n";
|
||||
return;
|
||||
}
|
||||
$self->normal_insert($ins, $depends,
|
||||
$ins->find_pathkey($pkgpath2),
|
||||
$ins->convert_depends($self->depends_type),
|
||||
$pkgspec, $rest);
|
||||
if ($libs ne '') {
|
||||
for my $lib (split(/\,/, $libs)) {
|
||||
$self->add_lib($ins, $lib);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub create_table
|
||||
{
|
||||
my ($self, $inserter) = @_;
|
||||
$inserter->make_table($self, undef,
|
||||
TextColumn->new("FULLDEPENDS"),
|
||||
OptTextColumn->new("PKGSPEC"),
|
||||
OptTextColumn->new("REST"),
|
||||
PathColumn->new("DEPENDSPATH"),
|
||||
TextColumn->new("TYPE"));
|
||||
$inserter->prepare_normal_inserter($self->table,
|
||||
"FULLDEPENDS", "DEPENDSPATH", "TYPE", "PKGSPEC", "REST");
|
||||
}
|
||||
|
||||
sub add_lib
|
||||
{
|
||||
}
|
||||
|
||||
sub table()
|
||||
{
|
||||
return "Depends";
|
||||
}
|
||||
|
||||
package LibDependsVar;
|
||||
our @ISA=(qw(DependsVar));
|
||||
sub depends_type() { 'Library' }
|
||||
|
||||
sub add_lib
|
||||
{
|
||||
my ($self, $ins, $lib) = @_;
|
||||
WantlibVar->add_value($ins, $lib);
|
||||
}
|
||||
|
||||
package RunDependsVar;
|
||||
our @ISA=(qw(DependsVar));
|
||||
sub depends_type() { 'Run' }
|
||||
|
||||
package BuildDependsVar;
|
||||
our @ISA=(qw(DependsVar));
|
||||
sub depends_type() { 'Build' }
|
||||
|
||||
package RegressDependsVar;
|
||||
our @ISA=(qw(DependsVar));
|
||||
sub depends_type() { 'Regress' }
|
||||
|
||||
# Stuff that gets stored in another table
|
||||
package SecondaryVar;
|
||||
our @ISA=(qw(KeyVar));
|
||||
sub add_value
|
||||
{
|
||||
my ($self, $ins, $value) = @_;
|
||||
$self->normal_insert($ins, $value);
|
||||
}
|
||||
|
||||
sub add_keyword
|
||||
{
|
||||
my ($self, $ins, $value) = @_;
|
||||
$self->add_value($ins, $self->keyword($ins, $value));
|
||||
}
|
||||
|
||||
sub create_table
|
||||
{
|
||||
my ($self, $inserter) = @_;
|
||||
$self->create_keyword_table($inserter);
|
||||
$inserter->make_table($self, "UNIQUE(FULLPKGPATH, VALUE)",
|
||||
ValueColumn->new);
|
||||
$inserter->prepare_normal_inserter($self->table, "VALUE");
|
||||
}
|
||||
|
||||
sub keyword_table()
|
||||
{
|
||||
return undef;
|
||||
}
|
||||
|
||||
package MasterSitesVar;
|
||||
our @ISA=(qw(OptKeyVar));
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
|
||||
my $n;
|
||||
if ($self->var =~ m/^MASTER_SITES(\d)$/) {
|
||||
$n = $1;
|
||||
}
|
||||
$self->normal_insert($ins, $n, $self->value);
|
||||
}
|
||||
|
||||
sub create_table
|
||||
{
|
||||
my ($self, $inserter) = @_;
|
||||
$self->create_keyword_table($inserter);
|
||||
$inserter->make_table($self, "UNIQUE(FULLPKGPATH, N, VALUE)",
|
||||
OptIntegerColumn->new("N"),
|
||||
ValueColumn->new);
|
||||
$inserter->prepare_normal_inserter($self->table, "N", "VALUE");
|
||||
}
|
||||
|
||||
sub table()
|
||||
{
|
||||
return "MasterSites";
|
||||
}
|
||||
|
||||
# Generic handling for any blank-separated list
|
||||
package ListVar;
|
||||
our @ISA=(qw(SecondaryVar));
|
||||
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
$self->AnyVar::add($ins);
|
||||
for my $d (main::words $self->value) {
|
||||
$self->add_value($ins, $d) if $d ne '';
|
||||
}
|
||||
}
|
||||
|
||||
sub columntype
|
||||
{
|
||||
my ($self, $name) = @_;
|
||||
return 'OptTextColumn';
|
||||
}
|
||||
|
||||
package ListKeyVar;
|
||||
our @ISA=(qw(SecondaryVar));
|
||||
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
$self->AnyVar::add($ins);
|
||||
for my $d (main::words $self->value) {
|
||||
$self->add_keyword($ins, $d) if $d ne '';
|
||||
}
|
||||
}
|
||||
|
||||
sub keyword_table()
|
||||
{
|
||||
return "Keywords";
|
||||
}
|
||||
|
||||
package QuotedListVar;
|
||||
our @ISA=(qw(ListVar));
|
||||
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
$self->AnyVar::add($ins);
|
||||
my @l = (main::words $self->value);
|
||||
while (my $v = shift @l) {
|
||||
while ($v =~ m/^[^']*\'[^']*$/ || $v =~m/^[^"]*\"[^"]*$/) {
|
||||
$v.=' '.shift @l;
|
||||
}
|
||||
if ($v =~ m/^\"(.*)\"$/) {
|
||||
$v = $1;
|
||||
}
|
||||
if ($v =~ m/^\'(.*)\'$/) {
|
||||
$v = $1;
|
||||
}
|
||||
$self->add_value($ins, $v) if $v ne '';
|
||||
}
|
||||
}
|
||||
|
||||
package DefinedListKeyVar;
|
||||
our @ISA=(qw(ListKeyVar));
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
return if $self->value eq '';
|
||||
$self->SUPER::add($ins);
|
||||
}
|
||||
|
||||
sub columntype
|
||||
{
|
||||
return 'OptValueColumn';
|
||||
}
|
||||
|
||||
package FlavorsVar;
|
||||
our @ISA=(qw(DefinedListKeyVar));
|
||||
sub table() { 'Flavors' }
|
||||
|
||||
package PseudoFlavorsVar;
|
||||
our @ISA=(qw(DefinedListKeyVar));
|
||||
sub table() { 'PseudoFlavors' }
|
||||
|
||||
package ArchListVar;
|
||||
our @ISA=(qw(DefinedListKeyVar));
|
||||
sub keyword_table() { 'Arch' }
|
||||
|
||||
package OnlyForArchListVar;
|
||||
our @ISA=(qw(ArchListVar));
|
||||
sub table() { 'OnlyForArch' }
|
||||
|
||||
package NotForArchListVar;
|
||||
our @ISA=(qw(ArchListVar));
|
||||
sub table() { 'NotForArch' }
|
||||
|
||||
package CategoriesVar;
|
||||
our @ISA=(qw(ListKeyVar));
|
||||
sub table() { 'Categories' }
|
||||
sub keyword_table() { 'CategoryKeys' }
|
||||
|
||||
package MultiVar;
|
||||
our @ISA=(qw(ListVar));
|
||||
sub table() { 'Multi' }
|
||||
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
return if $self->value eq '-';
|
||||
$self->SUPER::add($ins);
|
||||
}
|
||||
|
||||
package ModulesVar;
|
||||
our @ISA=(qw(DefinedListKeyVar));
|
||||
sub table() { 'Modules' }
|
||||
sub keyword_table() { 'ModuleKeys' }
|
||||
|
||||
package ConfigureVar;
|
||||
our @ISA=(qw(DefinedListKeyVar));
|
||||
sub table() { 'Configure' }
|
||||
sub keyword_table() { 'ConfigureKeys' }
|
||||
|
||||
package ConfigureArgsVar;
|
||||
our @ISA=(qw(QuotedListVar));
|
||||
sub table() { 'ConfigureArgs' }
|
||||
|
||||
package WantlibVar;
|
||||
our @ISA=(qw(ListVar));
|
||||
sub table() { 'Wantlib' }
|
||||
sub _add
|
||||
{
|
||||
my ($self, $ins, $value, $extra) = @_;
|
||||
$self->normal_insert($ins, $self->keyword($ins, $value), $extra);
|
||||
}
|
||||
|
||||
sub add_value
|
||||
{
|
||||
my ($self, $ins, $value) = @_;
|
||||
if ($value =~ m/^(.*)(\.\>?\=\d+\.\d+)$/) {
|
||||
$self->_add($ins, $1, $2);
|
||||
} elsif ($value =~ m/^(.*)(\.\>?\=\d+)$/) {
|
||||
$self->_add($ins, $1, $2);
|
||||
} else {
|
||||
$self->_add($ins, $value, undef);
|
||||
}
|
||||
}
|
||||
|
||||
sub create_table
|
||||
{
|
||||
my ($self, $inserter) = @_;
|
||||
$self->create_keyword_table($inserter);
|
||||
$inserter->make_table($self, "UNIQUE(FULLPKGPATH, VALUE)",
|
||||
ValueColumn->new,
|
||||
OptTextColumn->new("EXTRA"));
|
||||
$inserter->prepare_normal_inserter($self->table, "VALUE", "EXTRA");
|
||||
}
|
||||
|
||||
sub keyword_table() { 'Library' }
|
||||
|
||||
package OnlyForArchVar;
|
||||
our @ISA=(qw(DefinedListKeyVar));
|
||||
sub table() { 'OnlyForArch' }
|
||||
sub keyword_table() { 'Arches' }
|
||||
|
||||
package FileVar;
|
||||
our @ISA=(qw(SecondaryVar));
|
||||
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
$self->AnyVar::add($ins);
|
||||
open my $file, '<', $self->value or return;
|
||||
local $/ = undef;
|
||||
$self->add_value($ins, <$file>);
|
||||
}
|
||||
|
||||
sub table() { 'Descr' }
|
||||
|
||||
package SharedLibsVar;
|
||||
our @ISA=(qw(KeyVar));
|
||||
|
||||
sub add
|
||||
{
|
||||
my ($self, $ins) = @_;
|
||||
$self->AnyVar::add($ins);
|
||||
my %t = main::words($self->value);
|
||||
while (my ($k, $v) = each %t) {
|
||||
$self->normal_insert($ins, $self->keyword($ins, $k), $v);
|
||||
}
|
||||
}
|
||||
|
||||
sub create_table
|
||||
{
|
||||
my ($self, $inserter) = @_;
|
||||
$self->create_keyword_table($inserter);
|
||||
$inserter->make_table($self, "UNIQUE (FULLPKGPATH, LIBNAME)",
|
||||
ValueColumn->new("LIBNAME"),
|
||||
TextColumn->new("VERSION"));
|
||||
$inserter->prepare_normal_inserter($self->table, "LIBNAME", "VERSION");
|
||||
}
|
||||
|
||||
sub table()
|
||||
{
|
||||
"Shared_Libs"
|
||||
}
|
||||
|
||||
sub keyword_table()
|
||||
{
|
||||
return "Library";
|
||||
}
|
||||
|
||||
package EmailVar;
|
||||
our @ISA=(qw(KeyVar));
|
||||
sub keyword_table()
|
||||
{
|
||||
return "Email";
|
||||
}
|
||||
|
||||
package YesKeyVar;
|
||||
our @ISA=(qw(KeyVar));
|
||||
sub keyword_table()
|
||||
{
|
||||
return "Keywords2";
|
||||
}
|
||||
|
||||
package AutoVersionVar;
|
||||
our @ISA=(qw(OptKeyVar));
|
||||
|
||||
sub keyword_table()
|
||||
{
|
||||
return "AutoVersion";
|
||||
}
|
||||
|
||||
1;
|
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user