package WebGUI::Operation::MLthingy; use WebGUI::SQL; =head1 NAME Package WebGUI::Operation::MLthingy =head1 BENEFITS Ultimate solution for easy getting usable table and field names in your Thingy! 1. Change your thing structures with readable field names only by expanding your data form with new fields 2. Use thing table names like Thingy_mytable and thing field names like field_myfield instead of some very ugly names including assetId's 3. Easy SQLReports for Things 4. A lot of karma or other gifts to the author for his brilliant idea =head1 DESCRIPTION Operation for expanding an __existing__ Thing by using all the fields from a form like - a WebGUI DataForm object - a HTML-form, where fields are named by field_xxx, field_yyy etc. Using a DataForm, your existing Thing will be expanded by the same fields as you expand your DataForm with. =head2 www_mlthingfields( < $thingId | $label > ) calls renameThing if $session->form->process('rename') or saveFormfieldsToThing =head3 thingId The thingId of the Thing to expand (Table = "Thing_thingId") To use this, your thingId should be unique =head3 label The label of the Thing to expand To use this, your label should be unique =head2 saveFormfieldsToThing If $params->{allfields}, fieldnames from the form will be added to the thing. =head3 saveFormfieldsToThing from DataForm all fields but: $params->{allfields} == 1 && $fld =~ /^allfields$|thingId$|^op$|CsrfToken|func|entryId|rename/i will be added as field_ to the table Thingy_ =head3 saveFormfieldsToThing from HTML-form all fields but: !$params->{allfields} && $fld !~ /field_/ will be added als to the table Thingy_ =head2 Rename Thing Implemented but not yet tested extensively. It seems to work, but beware to use it, if you're using thing relations !!! if $session->form->process('rename'), Thingy_ will be renamed to Thingy_<$session->form->process('rename')> =head2 Examples =head3 HTML-Form 1. Init a Thingy 2. Init a Thing with name "myThing" with at least 1 field, e.g. "dummy" 3. Init an article or snippet form (to test, put it in the desription of your thingy):
The thing (thingId) to work with:
If you just initialized the thing, your thing will have a terrable thingId. You also may use the label, as long as it is unique
The thing (label) to work with:
Take all the fields of this form into myThing:
No, take only the fields with names like "field_XXX"
Yes and expand the used fieldname YYY to field_YYY
Expand table with fields:


(Please understand, this form doesn't use an action.
You don't have to fill in values. The MLthingy-op just takes the fields to expand your thing with.)
If you fill-in the next field, the thingId and the Thing tablename, but no field names will be changed.
If you're not using the label to select, remember to use that name with your next change.
Please be very carefull, especially if you have thing relations, since this is tested only for some cases. New Thingname:
4. Try out and see, what your thing is doing (Normal thing views or manage things) 5. change the form, again and again if you like 6. Test the same procedure with a DataForm as starting object. =head3 DataForm usage If you initialize a DataForm, give it the fields as shown in the above example. Fieldnames will be expanded by 'field_' before taken over by your thing table. =head2 Installation 1. Copy to your (Custom-) Macros or subdirectory 2. Expand Operation.pm getOperations with: 'mlthingfields' => 'MLthingy', =head3 TODO's Should be implemented as a Content Module to prevent using the fieldname "op" =head2 DISCLAIMER / GOTCHAS No tests for acceptable table or field names, so think before you do and/or watch your database to see what's happening! This program works or works not and even doesn't tell you why. So use this operation on your own risk!!! It only works for the author's purposes =head1 AUTOR/COPYRIGHT Martien A. M. Lammers, webguide@innovate.de @(#) Version: $Revision: #6 $ @(#) $Change: 3807 $ @(#) Datum: $Date: 2011/11/25 $ =cut use Data::Dumper; #-------------------------------- just my own debug sub _debug { my $comment = shift; my $var = shift; open( O, ">>/tmp/debug.log" ); if ( $comment =~ /[a-z]/ ) { print O "#-------------$comment\n"; } print O Dumper($var); close O; } #------------------------------------------------------------------- MAIN OP sub www_mlthingfields { my $session = shift; my $thingId = $session->form->process('thingId') || $session->form->process('thingid'); my $label = $session->form->process('thingLabel'); if ( $label =~/[a-zA-Z]/ ){ my $sql = "SELECT thingId from Thingy_things where label= '$label'"; ($thingId) = $session->db->quickArray($sql); } my $testThing = testThing( $session, $thingId ); if ( $testThing->{thingyAssetId} ) { # that's my $thingy my ($thingyId) = $session->db->quickArray("select assetId from Thingy_things where thingId = '$thingId'"); # get the thingy info my $thingy = WebGUI::Asset::Wobject::Thingy->new( $session, $thingyId ); # we also can rename the thing my $newthingname = $session->form->process('rename'); if ( $newthingname=~/[a-zA-Z]/ ){ $newthingname =~y/[a-zA-Z//cd; $newthingname = substr($newthingname,0,15); renameThing( $session, $thingId, $newthingname ); }else{ # save form fields to thing saveFormfieldsToThing( $session, $thingy, $thingId ); } } return undef; } ## end sub www_mlthingfields #-------------------------------------------------------------------------- sub saveFormfieldsToThing { my $session = shift; my $thingy = shift; my $thingId = shift; return undef unless $thingId; my $fieldId; my $params = $session->form->paramsHashRef(); my ( $newThingDataId, $errors ); my %fieldProperties; foreach my $fld ( keys %{$params} ) { if ( # using e.g. a dataform with a field "allfields=1" and all fields exept regexp can be copied to the thing $params->{allfields} == 1 && $fld =~ /^allfields$|thingId$|^op$|CsrfToken|func|entryId|rename/i # if ! allfields, save all fields starting with 'field_' || ( !$params->{allfields} && $fld !~ /field_/ ) ) { next; } my $newfldId = $fld; $newfldId =~ s/field_//; # be sure about existence of field $fieldId = testAddThingField( $session, $thingy, $thingId, $newfldId ); # read the values $fieldProperties{"field_$fld"} = $params->{$fld}; } ## end foreach my $fld ( keys %{$params...}) # init / save field ( $newThingDataId, $errors ) = $thingy->editThingDataSave( $thingId, $thingDataId, \%fieldProperties ); return ( $newThingDataId, $errors ); } ## end sub saveFormfieldsToThing sub testAddThingField { my $session = shift; my $thingy = shift; my $thingId = shift; my $fieldId = shift; # Test adding a field ??? my ($isValidId) = $session->db->quickArray( "select fieldId from Thingy_fields where thingId = '$thingId' and fieldId ='$fieldId'" ); # if field doesn't exist if ( !$isValidId && $fieldId ) { my %fieldProperties = ( thingId => $thingId, fieldId => $fieldId, label => $fieldId, dateCreated => time(), dateUpdated => time(), createdBy => $session->user->userId, updatedBy => $session->user->userId, fieldType => "Text", status => "editable", display => 1, ); $fieldId = addThingField( $session, $thingy, $fieldId, \%fieldProperties ); } return $fieldId; } ## end sub testAddThingField # new field if necessary sub addThingField { my $session = shift; my $thingy = shift; my $fieldId = shift; my $fieldProperties = shift; my $dbDataType = shift || "CHAR(255)"; my $db = $session->db; my $error = $session->errorHandler; my ( $oldFieldId, $newFieldId, $useAssetId, $useSequence ); $error->info( "Adding Field, label: " . $fieldProperties->{label} . ", fieldId: " . $fieldProperties->{fieldId} . ",thingId: " . $fieldProperties->{thingId} ); $oldFieldId = $fieldProperties->{fieldId}; $fieldProperties->{fieldId} = "new"; # add a new field with Id =~ UUID $newFieldId = $thingy->setCollateral( "Thingy_fields", "fieldId", $fieldProperties, 1 ); # change the fieldId to something reasonable to work with # at first in Thingy_fields $db->write( "update Thingy_fields set fieldId = " . $db->quote($oldFieldId) . " where fieldId = " . $db->quote($newFieldId) ); $newFieldId = $oldFieldId; # then in Thing my $thingyTableName = "Thingy_" . $fieldProperties->{thingId}; my $columnName = 'field_' . $newFieldId; $db->write( "ALTER TABLE " . $db->dbh->quote_identifier($thingyTableName) . " ADD " . $db->dbh->quote_identifier($columnName) . " " . $dbDataType ); return $newFieldId; } ## end sub addThingField # renames a thing sub renameThing { my $session = shift; my $thingId = shift; my $newThingId = shift; if ( $newThingId && $thingId ) { # new name for thing # $thingId doesn't exist? my $testthing = testThing( $session, $thingId ); return undef unless $testthing->{thingyAssetId} ; my $newtable_name = "Thingy_" . $newThingId; $newThingId = $newtable_name; $newThingId =~ s/^Thingy_//i; $newThingId =~ y/[a-zA-Z]//cd; # $newThingId exists? my $testNewThing = testThing( $session, $newThingId ); return undef if $testNewThing->{thingyAssetId}; my $assetId = $testthing->{thingyAssetId}; $session->db->beginTransaction(); if ( $newThingId ) { # Rename Thing $session->db->read( 'alter table ' . $session->db->dbh->quote_identifier( 'Thingy_' . $thingId ) . " rename " . $session->db->dbh->quote_identifier($newtable_name) ); $session->db->read( 'update Thingy_things set thingId = "' . $newThingId . '" where assetId = "' . $assetId . '" and thingId = "' . $thingId . '"' ); $session->db->read( 'update Thingy_things set label = "' . $newThingId . '" where assetId = "' . $assetId . '" and thingId = "' . $newThingId . '"' ); $session->db->read( 'update Thingy set defaultThingId = "' . $newThingId . '" where assetId = "' . $assetId . '" and defaultThingId = "' . $thingId . '"' ); $session->db->read( 'update Thingy_fields set thingId = "' . $newThingId . '" where assetId = "' . $assetId . '" and thingId = "' . $thingId . '"' ); $session->db->read( 'update Thingy_fields set fieldType = "otherThing_' . $newThingId . '" where assetId = "' . $assetId . '" and fieldType ="otherThing_' . $thingId . '"' ); # $session->db->read( 'update Thingy_fields set fieldInOtherThingId = "otherThing_' # . $newThingId # . '" where assetId = "' # . $self->getId # . '" and fieldInOtherThingId ="otherThing_' # . $thingId # . '"' ); if ( $session->db->commit() ) { $thingId = $newThingId; } else { $session->db->rollback(); } } ## end if ($newThingId) } ## end if ( "$newThingId" ne ...) } # testThing # $testthing = testthing( $session, $thingId ); # Tests if a thing already exists # returns { $thingId => < 0 [ | 1 , thingyAssetId => assetID ] > } sub testThing { my ( $session, $thingId ) = @_; my $db = $session->db; my $tableName = "Thingy_" . $thingId; my $testThing = { thingId => $thingId, tableName => "", thingyAssetId => "" }; if ($thingId) { # column name could be erroneous, so: my $sth = $db->read( 'show tables like ?', [$tableName] ); while ( my @tableInfo = $sth->array ) { if ( $tableInfo[0] eq $tableName ) { # table exists $testThing->{tableName} = $tableName; # thing belongs to my ($thingyAssetId) = $session->db->quickArray( "select assetId from Thingy_things where thingId = ?", [$thingId] ); $testThing->{thingyAssetId} = $thingyAssetId; } } } ## end if ($thingId) return $testThing; } ## end sub testThing 1;