Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Perl/Moose calling writer doesnt work

by jorba (Sexton)
on Mar 10, 2018 at 12:21 UTC ( [id://1210614]=perlquestion: print w/replies, xml ) Need Help??

jorba has asked for the wisdom of the Perl Monks concerning the following question:

Having a weird problem with perl/Moose.

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;

[download]

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;

[download]

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>

[download]

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

    I concur with haukex that you should make a SSCCE to demonstrate/research your issue. Something very simple like: 

    # 1210614.pl
package MyClass {
    use Moose;
    has FileName => (is => 'rw', isa => 'Str', writer => 'SetFileName'
+);
    sub SetFileName {
        my $self = shift;
        my $arg = shift;
        warn "I am here with $arg";
    }
};

package main {
    my $obj = MyClass->new;
    $obj->SetFileName('/foo/bar');
};

    [download]
    This will show you the error clearly. Output: 
    $ perl 1210614.pl
You are overwriting a locally defined method (SetFileName) with an acc
+essor ...

    [download]

    As you can see this is not what specifying a custom writer does. As far as I understand it, specifying a custom writer property for an attribute simply changes the name of the writer from the default. 

    # 1210614-1.pl
package MyClass {
    use Moose;
    has FileName => (is => 'rw', isa => 'Str', writer => 'SetFileName'
+);
};

package main {
    my $obj = MyClass->new;
    $obj->SetFileName('/foo/bar');
    warn $obj->FileName;
};

    [download]
    Output: 
    $ perl 1210614-1.pl
/foo/bar at 1210614-1.pl line 9.

    [download]

    For what you are doing your code should use a custom type check, or a coercion, or a trigger instead. 

    # 1210614-2.pl
package MyClass {
    use Moose;
    has FileName => (is => 'rw', isa => 'Str', trigger => \&SetFileNam
+e);
    sub SetFileName {
        my $self = shift;
        my $arg = shift;
        warn "I am here with $arg";
    }
};

package main {
    my $obj = MyClass->new;
    $obj->SetFileName('/foo/bar');
};

    [download]
    Output: 
    $ perl 1210614-2.pl
I am here with /foo/bar at 1210614-2.pl line 7.

    [download]

    Hope this helps!


    The way forward always starts with a minimal test.
[reply]
[d/l]
[select]

      That makes a lot of sense. If changing the writer only changes the name of the accessor, rather than allowing you to build your own custom version, that explains the error message and the failure to work. Off to investigate custom type chacks coercions and triggers. Only bad news is this means I need to rewrite a lot of my code, but then, perhaps it will work properly. Many thanx

[reply]

        It looks like your current code can be used just by removing the writer parameter. It looks, to me, like you are making some checks in SetFileName and then set the parameter using the standard accessor. Thus, something like this should work for you:

        use 5.010;

package MyClass {
    use Moose;
    has FileName => (is => 'rw', isa => 'Str');
    sub SetFileName {
        my $self = shift;
        my $arg = shift;
        warn "I am here with $arg";
        $self->FileName($arg) if $arg =~ /foo/;
    };
};

package main {
    my $obj = MyClass->new;
    $obj->SetFileName('/bar/baz');
    say "FileName is: ", $obj->FileName;
    $obj->SetFileName('/foo/bar');
    say "FileName is: ", $obj->FileName;
};

        [download]

        Though normally, if you want to force use of a custom writer you would change the default writer to start with an underscore to indicate that it should be treated as a private method (Note: treating underscore methods as private is a convention, it is not enforced):

        use 5.010;

package MyClass {
    use Moose;
    has FileName => (is => 'rw', isa => 'Str', writer => "_SetFileName
+");
    sub SetFileName {
        my $self = shift;
        my $arg = shift;
        warn "I am here with $arg";
        $self->_SetFileName($arg) if $arg =~ /foo/;
    };
};

package main {
    my $obj = MyClass->new;
    $obj->SetFileName('/bar/baz');
    say "FileName is: ", $obj->FileName;
    $obj->SetFileName('/foo/bar');
    say "FileName is: ", $obj->FileName;
};

        [download]

        Also note that your custom SetFileName will not be called if FileName is passed to new(). For that you would have to do something in BUILD or else some of the other special methods or such.

        Good Day,
            Dean

[reply]
[d/l]
[select]
Re: Perl/Moose calling writer doesnt work
by haukex (Archbishop) on Mar 10, 2018 at 12:59 UTC

    You've posted a ton of code that looks to me to be mostly unrelated to the problem. It also depends on external code that we don't have (use AXControl; use AXRecord;), so we can't even compile the code. You'll have to remove all irrelevant code and turn this into a Short, Self-Contained, Correct Example that we can run and that demonstrates the problem.

    Having said that, if I try that, I get an error message: "You are overwriting a locally defined method (SetFileName) with an accessor at ...". Maybe you could explain what you are trying to do with SetFileName in the first place?

[reply]
[d/l]
[select]
      The point of SetFileName is that there are several things that need to be done when a filename is changed, not just assigning the value. I saw the message you refer to as an error. I didnt realise this was an error (in amongst all the messages Moose generates). I'll take a look at that and try to downsize the code.
[reply]
Re: Perl/Moose calling writer doesnt work
by jeffenstein (Hermit) on Mar 10, 2018 at 15:10 UTC
    edit oops... I read the question wrong; the attribute is being set from outside the class, so my previous post wasn't correct.

    Update: As AnomalousMonk mentions below, I should have kept the original to remind me to read carefully before hitting submit ;)

    So, here's the code I originally posted, using lazy to set the attribute based on information the class learns after it's created: 

    has FileName => (
    is => 'ro',
    isa => 'Str',
    lazy => 1,
    builder => '_build_filename',
);

sub _build_filename {
    my $self = shift;
    # build logic here
    return $filename;
}

    [download]
[reply]
[d/l]

      Please see How do I change/delete my post? for site etiquette and protocol regarding removal of a post. Occasionally, even a gross misunderstanding may prove enlightening to others. (And attributing your "oops" to poor old edit, who hasn't been here in fourteen years, is not done, old man, it's just not playing the game. :)

      Give a man a fish:  <%-{-{-{-<

[reply]
[d/l]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://1210614]
Approved by marto
Front-paged by 1nickt
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others surveying the Monastery: (5)
As of 2024-04-24 12:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found