[Bast-commits] r3363 - trunk/Anything/lib/Anything
castaway at dev.catalyst.perl.org
castaway at dev.catalyst.perl.org
Tue May 22 17:13:10 GMT 2007
Author: castaway
Date: 2007-05-22 17:13:07 +0100 (Tue, 22 May 2007)
New Revision: 3363
Added:
trunk/Anything/lib/Anything/Utils.pm
Log:
Add missing Utils module
Added: trunk/Anything/lib/Anything/Utils.pm
===================================================================
--- trunk/Anything/lib/Anything/Utils.pm (rev 0)
+++ trunk/Anything/lib/Anything/Utils.pm 2007-05-22 16:13:07 UTC (rev 3363)
@@ -0,0 +1,267 @@
+package Anything::Utils;
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+use XML::Simple;
+use Data::Dumper;
+use DB::Anything;
+
+sub setup
+{
+ # Create standard entries
+ my ($dsn, $db_user, $db_pass, $debug) = @_;
+
+ DB::Anything->load_classes({ 'Anything::Model::Anything' =>
+ ['Type',
+ 'Items',
+ 'Relationships',
+ 'Admin',
+ 'MajorMinor',
+ 'TypeFields',
+ 'ItemValues',
+ 'TypeAttributes'
+ ]
+ });
+ my $dbschema = DB::Anything->connect($dsn, $db_user, $db_pass);
+
+# print STDERR "STORAGE ", $dbschema->storage;
+
+ $dbschema->populate('Type',
+ [ [ 'ID', 'Name', 'ParentID', 'System' ],
+ [ 0, 'Item', undef, 1 ],
+# [ 1, 'Field', 1, \('DEFAULT') ],
+ [ 1, 'Field', 1, 0 ],
+ [ 2, 'DateField', 1, 1 ],
+ [ 3, 'TextField', 1, 1 ],
+ [ 4, 'NumberField', 1, 1 ],
+# [ 5, 'Person', \('DEFAULT'), \('DEFAULT') ],
+ [ 5, 'Person', 0, 0 ],
+# [ 6, 'Role', \('DEFAULT'), \('DEFAULT') ],
+ [ 6, 'Role', 0, 0 ],
+# [ 7, 'User', 5, \('DEFAULT') ],
+ [ 7, 'User', 5, 0 ],
+# [ 8, 'Document', \('DEFAULT'), \('DEFAULT') ],
+ [ 8, 'Document', 0, 0 ],
+# [ 9, 'Note', 8, \('DEFAULT') ],
+ [ 9, 'Note', 8, 0 ],
+ ]
+ );
+
+ $dbschema->populate('Items',
+ [ [ 'ID', 'TypeID', 'Name', 'Description' ],
+ [ 1, 3, 'First Name', 'Persons first name'],
+ [ 2, 3, 'Last Name', 'Persons last name' ],
+ [ 3, 3, 'Email', 'Persons email address' ],
+ [ 4, 3, 'Username', 'Users login name' ],
+ [ 5, 3, 'Password', 'Users password' ],
+ [ 6, 3, 'Page Size', 'How many items to show per page' ],
+ [ 7, 6, 'Admin', 'Administrators' ],
+ [ 8, 3, 'Description', '' ],
+ ]);
+
+ $dbschema->populate('TypeFields',
+ [ [ 'TypeID', 'FieldID' ],
+ [ 5, 1],
+ [ 5, 2],
+ [ 5, 3],
+ [ 7, 4],
+ [ 7, 5],
+ [ 7, 6],
+ [ 0, 8],
+ ]);
+
+ $dbschema->populate('RelationTypes',
+ [ [ 'ID', 'Name' ],
+ [ 1, '<unknown>' ],
+ [ 2, 'Owner' ],
+ ]);
+
+ if($dbschema->storage->isa('DBIx::Class::Storage::DBI::DB2'))
+ {
+ $dbschema->storage->dbh->do("ALTER TABLE Type ALTER ID RESTART WITH 10");
+ $dbschema->storage->dbh->do("ALTER TABLE Items ALTER ID RESTART WITH 9");
+ $dbschema->storage->dbh->do("ALTER TABLE RelationTypes ALTER ID RESTART WITH 3");
+ }
+
+}
+
+# import XML datasets into the database.
+sub import_dataset
+{
+ my ($dataset, $dsn, $db_user, $db_pass, $debug) = @_;
+
+ my $datalayout = XMLin($dataset, KeyAttr => [],
+ GroupTags => { types => 'type',
+ attributes => 'attribute',
+ fields => 'field',
+ items => 'item',
+ values => 'value',
+ relationships => 'relationship'
+ },
+ SuppressEmpty => 1,
+ ForceArray => [qw/item
+ type
+ field
+ attribute
+ value
+ relationship
+ major
+ minor/]);
+ print(Dumper($datalayout)) if $debug;
+
+ print "Importing dataset: $datalayout->{name}, version $datalayout->{version}, created on $datalayout->{created}\n";
+
+ DB::Anything->load_classes({ 'Anything::Model::Anything' =>
+ ['Type',
+ 'Items',
+ 'Relationships',
+ 'Admin',
+ 'MajorMinor',
+ 'TypeFields',
+ 'ItemValues',
+ 'TypeAttributes'
+ ]
+ });
+ my $dbschema = DB::Anything->connect($dsn, $db_user, $db_pass);
+
+ my $admin = $dbschema->resultset('Admin')->find_or_create({
+ Package => $datalayout->{name},
+ Version => $datalayout->{version} });
+
+ foreach my $type (@{$datalayout->{types} || []})
+ {
+# $type = $type->{type};
+ my ($pobj) = $dbschema->resultset('Type')->search({Name => 'Item'});
+ if($type->{parent})
+ {
+ ($pobj) = $dbschema->resultset('Type')->search({
+ Name => $type->{parent}});
+ }
+ my $tobj = $dbschema->resultset('Type')->find_or_create({
+ Name => $type->{name},
+ Description => $type->{description},
+ ParentID => $pobj->ID,
+ System => 0,
+ });
+ while (my ($f, $v) = each %{$type})
+ {
+ next if(ref($v));
+ next if($f eq 'name' or
+ $f eq 'description' or
+ $f eq 'parent');
+ if($tobj->has_column($f))
+ {
+ $tobj->set_column($f, $v);
+ }
+ else
+ {
+ warn "$type->{name} does not have a column called $f\n";
+ }
+ }
+ $tobj->update;
+
+ foreach my $field (@{$type->{fields} || []})
+ {
+# $field = $field->{field};
+ next if(!$field);
+ my ($ftobj) = $dbschema->resultset('Type')->search({
+ Name => $field->{type}
+ });
+ if(!$ftobj)
+ {
+ warn "Can't find field type $field->{type}\n";
+ next;
+ }
+ my $fobj = $dbschema->resultset('Items')->find_or_create({
+ Name => $field->{name},
+ Description => $field->{description},
+ TypeID => $ftobj->ID,
+ });
+ my $tfobj = $tobj->find_or_create_related('typefields', {
+ FieldID => $fobj->ID,
+ });
+ $tfobj->update;
+# while (my ($f, $v) = each %{$field})
+# {
+# next if(ref($v));
+# next if($f eq 'name' or $f eq 'description');
+# if($fobj->has_column($f))
+# {
+# $fobj->set_column($f, $v);
+# }
+# }
+ $fobj->update;
+ }
+
+ if(@{$type->{attributes} || []})
+ {
+ my $aobj = $tobj->find_or_create_related('attributes', {});
+ foreach my $attr (@{$type->{attributes}})
+ {
+# $attr = $attr->{attribute};
+ $aobj->set_column("$attr->{name}Field" => $attr->{text});
+ }
+ $aobj->update;
+ }
+
+ foreach my $item (@{$type->{items} || []})
+ {
+# $item = $item->{item};
+ next if(!$item);
+ my $iobj = $tobj->find_or_create_related('items', {
+ Name => $item->{name},
+ Description => $item->{name},
+ });
+
+ foreach my $value (@{$item->{values} || []})
+ {
+# $value = $value->{value};
+ my ($field) = $tobj->typefields->search_related('FieldID', {
+ Name => $value->{field}
+ });
+ if(!$field)
+ {
+ warn "$type->{name} does not have a field name $value->{field}\n";
+ next;
+ }
+ $iobj->find_or_create_related('itemvalues',{
+ FieldID => $field->ID,
+ Value => $value->{value},
+ });
+ }
+ }
+ }
+
+ foreach my $major (@{$datalayout->{admin}{major} || []})
+ {
+ my ($majtype) = $dbschema->resultset('Type')->search({
+ Name => $major->{name} });
+ if(!$majtype)
+ {
+ warn "Unknown major type: $major->{name}\n";
+ next;
+ }
+ foreach my $minor (@{$major->{minor} || []})
+ {
+ my ($mintype) = $dbschema->resultset('Type')->search({
+ Name => $minor->{name} });
+ if(!$mintype)
+ {
+ warn "Unknown major type: $minor->{name}\n";
+ next;
+ }
+
+ my ($majmin) = $dbschema->resultset('MajorMinor')->find_or_create({
+ PackageID => $admin->PackageID,
+ MajorID => $majtype->ID,
+ MinorID => $mintype->ID,
+ });
+ }
+ }
+
+ return 1;
+}
+
+1;
More information about the Bast-commits
mailing list