jorba has asked for the wisdom of the Perl Monks concerning the following question:
Calling a writer for an attribute in a class to set the attribute value, but as far as I can tell the writer doesnt actually get called. The problem is with the call to SetFleName on line 15.
Here is the calling code
use lib 'C:\Users\Jay\Desktop\SBS DEV\CODE\perl\Utilities'; use AXControl; use AXSQL; use AXField; use Moose; use DBI; use DocPart; my ($cntl,$dp, $i, $rc); $cntl = AXControl->new(System => "paperless"); $dp = DocPart->new(ControlObject => $cntl, DocID => 1, Seq => 1); print "bef call\n"; $rc = $dp->SetFileName('C:\Users\Jay\Desktop\SBS DEV\CODE\perl\tes +t scripts\testdoc_part.pl'); print "set filename $rc\n"; my $x = $dp->Save; print "save rc $x\n"; print "Err msg " . $dp->ErrMsg;
Here is the code for the doc part object
package DocPart; # Our libraries use lib 'C:\Users\Jay\Desktop\SBS DEV\CODE\perl\Utilities'; use AXControl; use AXRecord; use Moose; use DBI; # Attributes has 'ControlObject' => (is => 'rw', isa => 'Object', required => 1); has 'DocID' => (is => 'rw', isa => 'Num', writer => 'SetDocID'); has 'Seq' => (is => 'rw', isa => 'Num', writer => 'SetSeq'); has 'FileName' => (is => 'rw', isa => 'Str', writer => 'SetFileName'); has 'Rec' => (is => 'rw', isa => 'Object'); has 'Valid' => (is => 'rw', isa => 'Bool'); has 'ErrMsg' => (is => 'rw', isa => 'Str'); #private - should not be accessed by outside code has 'NewDocPart' => (is => 'rw', isa => 'Bool'); sub BUILD { my ($self, $db); $self = shift; $self->Valid(0); if (defined($self->DocID) and defined($self->Seq)) { $self->Rec( AXRecord->new(ControlObject => $self->ControlObjec +t, Name => 'document_part', Where => "WHERE DOC_ID = " . $self->DocID + . " AND SEQNO = " . $self->Seq)); $self->NewDocPart(0); } else { $self->Rec( AXRecord->new(ControlObject => $self->ControlObjec +t, Name => 'document_part')); $self->NewDocPart(1); } } sub SetDocID { my $self; $self->DocID = shift; $self->get; } sub SetSeq { my $self; $self->Seq = shift; $self->get; } sub get { my ($self, $Where); if ($self->ControlObject->IsNumber($self->DocId) and $self->Contro +lObject->IsNumber($self->Seq)) { $Where = "WHERE DOC_ID = " . $self->DocID() . " AND SEQNO = " +. $self->Seq(); $self->Rec->Select(Where => $Where); if ($self->Rec->Populated()) { $self->NewDocPart(0); $self->Valid(1); $self->FileName($self->Rec->GetField("FILENAME")); } } } sub Validate { my $self; $self = shift; $self->Valid(1); $self->ErrMsg(" "); if ( not $self->ControlObject->IsNumber($self->DocID)) { $self->Valid(0); $self->ErrMsg("DocID is non numeric"); } if (not $self->ControlObject->IsNumber($self->Seq)) { $self->Valid(0); $self->ErrMsg("Seq is non numeric"); } if (not $self->Rec->Populated() and $self->Rec->GetField("FILENAME +")->Value eq " " ) { $self->Valid(0); $self->ErrMsg("Filename required for new document."); } else { if (not -e $self->FileName) { $self->Valid(0); $self->ErrMsg("File named does not exist."); } } } sub Save { my ($SQLStr, $sql, $self); $self = shift; $self->Validate; if ($self->Valid) { if ($self->Rec->Populated) { #Existing Record if ($self->Rec->GetField("FILENAME")->Value ne $self->Rec- +>GetField("FILENAME")->OriginalValue) { #First delete any existing segments for this document +part $SQLStr = "DELETE FROM doc_part_segment WHERE DOC_ID = + " . $self->DocID . " AND SEQNO = " . $self->Seq; $sql = AXSQL->new(ControlObject => $self->ControlObjec +t, SQLString => $SQLStr); # load new file $self->LoadFile } $self->Rec->Update; } else { #load new file $self->Rec->Insert; $self->LoadFile; } return 1; } else { return 0; } } sub SetFileName { my ($self, $fn); $self = shift; $fn = shift; print "fn $fn\n"; if (not -e $fn) { print "ret 0\n"; return 0; } else { $self->Rec->GetField("FILENAME")->NewValue($fn); $self->FileName($fn); print "ret 1\n"; return 1; } } sub LoadFile { my $self; #read the file, split it into segments of the appropriate size and + load to the db my ($maxlen, $db, $sql, $cnt, $data); open FILE, "<" . $self->Rec->GetField("FILENAME") or die "cant ope +n file " . $self->Rec->GetField("FILENAME"); #need to get this from the db next $maxlen = 1000; $db = $self->ControlObject->{"SysHandle"}; $sql = $db->prepare(qq{INSERT INTO doc_part_segment (DOC_ID, SEQNO +, SEGMENT_NO, FILE_SEGMENT) VALUES(?,?,?,?)}); read FILE, $data, $maxlen; $cnt = 1; while($data) { $sql->execute($self->DocID, $self->Seq, $cnt, $data); read FILE, $data, $maxlen; $cnt++; } close FILE; } 1;
Here is the output I get (I've left out the majority of the moose messages)
SQL select column_name, column_key, character_maximum_length, numeric_ +scale, data_type, numeric_precision, datetime_precision from informat +ion_schema.columns where table_schema = 'paperless' and table_name = +'document_part' order by ordinal_position SQL RowCount 4 SQL SELECT * FROM document_part WHERE DOC_ID = 1 AND SEQNO = 1 SQL RowCount 0 bef call set filename C:\Users\Jay\Desktop\SBS DEV\CODE\perl\test scripts\testd +oc_part.pl save rc 0 Err msg Filename required for new document. C:\Users\Jay\Desktop\SBS DEV\CODE\perl\test scripts>
What am I doing wrong?
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Perl/Moose calling writer doesnt work
by 1nickt (Canon) on Mar 10, 2018 at 13:24 UTC | |
by jorba (Sexton) on Mar 10, 2018 at 13:36 UTC | |
by duelafn (Parson) on Mar 10, 2018 at 18:48 UTC | |
|
Re: Perl/Moose calling writer doesnt work
by haukex (Archbishop) on Mar 10, 2018 at 12:59 UTC | |
by jorba (Sexton) on Mar 10, 2018 at 13:04 UTC | |
|
Re: Perl/Moose calling writer doesnt work
by jeffenstein (Hermit) on Mar 10, 2018 at 15:10 UTC | |
by AnomalousMonk (Archbishop) on Mar 10, 2018 at 16:10 UTC |