plperl user function - Mailing list pgsql-novice

From Keith Worthington
Subject plperl user function
Date
Msg-id 20050421191858.M96183@narrowpathinc.com
Whole thread Raw
Responses Re: plperl user function  (Olivier Thauvin <olivier.thauvin@aerov.jussieu.fr>)
List pgsql-novice
Hi All,

Three days ago I figured out that the text processing that I needed to do was
not going to be easy and perhaps even impossible in plpgsql.  Undaunted I set
out to learn perl, write a program, add plperl to my database and create a
plperl function.  As I said that was 3 days ago. 8-0  But now I am back and I
have only the last item to accomplish.  The function is written out below and
an example call to it is here

SELECT * FROM func_extract_size(quote_literal('3000 HTPP Black 4in sq Border:
 WNY200BK Size:  14\'8.5" x 16\'7" Tag:  None'));

First run through I get
ERROR:  creation of Perl function failed: 'require' trapped by operation mask
at (eval 12) line 4.

Hmmm, so I lose the "use strict;"  On the next run I get
ERROR:  creation of Perl function failed: 'require' trapped by operation mask
at (eval 14) line 4.

Okay, so I put the "use strict;" back in and delete "use warnings;"  On the
next run I get
ERROR:  creation of Perl function failed: 'require' trapped by operation mask
at (eval 16) line 4.

So now I figure well I can't use either of them.  Naturally I delete "use
warnings;" again so that neither of them are in the function.  On the next run
I get
ERROR:  error from Perl function: Can't call method "RETURN" without a package
or object reference at (eval 18) line 96.

This leaves me with two questions.
1)  Why can I not use "use strict;" or "use warnings;" as they are apparently
good perl programming practice.  I say apparently because if you remember I
started learning this language 3 days ago and must be considered a neophyte. :-)
2)  What is wrong with the use of RETURN?

Kind Regards,
Keith

-- Function: func_extract_size(varchar)

-- DROP FUNCTION func_extract_size("varchar");

CREATE OR REPLACE FUNCTION func_extract_size("varchar")
  RETURNS int AS
$BODY$
#  A function to extract the net size.
#  One input argument.  description  Case insensitive.

#  Define a subroutine that accepts a dimension string (xx' xx") and returns
#  feet and inch strings.
   sub sub_parse_dimension{
#     Initialize local variables.
      my $v_feet_str = "";
      my $v_inch_str = "";
      my $v_dim_str = shift(@_);
#     Split the dimension into feet and inch parts using pattern matching
#     and parentheses to capture the desired parts.
      $v_dim_str =~ /(?:([\d\.\s\-\/]+)')?\s*(?:([\d\.\s\-\/]+)")?/;
      $v_feet_str = defined $1 ? $1 : 0;
      $v_inch_str = defined $2 ? $2 : 0;
      return ($v_feet_str, $v_inch_str);
   }

#  Define a subroutine that accepts a mixed number string and returns
#  a decimal number.
   sub sub_xform_mixed_number{
#     Initialize local variables.
      my $v_decimal = 0;
      my $v_dim_str = shift(@_);
#     Check for fraction in dimension string.
      if ($v_dim_str =~ /\//){
#        There is a fraction to deal with.
#        Parse the fraction using whitespace or a hyphen (-) and the forward
#        slash (/) character.
         $v_dim_str =~ /(?:([\d\.]+))?[\-\s]*(?:(\d+))?\/(?:(\d+))?/;
         my $v_whole = defined $1 ? $1 : 0;
         my $v_numer = defined $2 ? $2 : 0;
         my $v_denom = defined $3 ? $3 : 0;
         $v_decimal = $v_whole + $v_numer/$v_denom;
      } else {
#        There is no fraction present.  Set the output equal to the input.
         $v_decimal = $v_dim_str;
      }
      return $v_decimal;
   }

#  Begining of the program.
   my $v_description = shift(@_);
   my $v_border_id = "";
   my $v_dim1_total = 0;
   my $v_dim2_total = 0;
   my $v_tag = "";

#  Perform a case insensitive check for the proper data format.  Capture the
#  desired parts of the data using parentheses.
   if (/.*border:\s*(.*)\s*size:\s*(.*)\s*tag:\s*(.*)\s*/i){
#     Store the capture patterns in variables to avoid unpredictable results.
      my ($v_border_str, $v_size_str, $v_tag_str) = ($1, $2, $3);
#     Check for no border.
      if ($v_border_str =~ /none/i){
         $v_border_id = "";
      } else {
         $v_border_id = $v_border_str;
      }
#     Parse up the size string.
      if ($v_size_str =~ /\d+\s*['"]\s*x\s*\d+\s*['"]/i){
#        It looks like a size string so continue to process.
         my $v_dim1_str = "";
         my $v_dim2_str = "";
         my $v_feet_str = "";
         my $v_inch_str = "";
#        Split the size string into its two parts.
         ($v_dim1_str, $v_dim2_str) = split(/\s*x\s*/i, $v_size_str);
#        Now split dimension one into feet and inch parts.
         ($v_feet_str, $v_inch_str) = sub_parse_dimension($v_dim1_str);
#        Merge the components of the dimension into a single value.
         $v_dim1_total = ( ( 12 * sub_xform_mixed_number($v_feet_str) )
                           + sub_xform_mixed_number($v_inch_str)
                         );
#        Now split dimension two into feet and inch parts.
         ($v_feet_str, $v_inch_str) = sub_parse_dimension($v_dim2_str);
#        Merge the components of the dimension into a single value.
         $v_dim2_total = ( ( 12 * sub_xform_mixed_number($v_feet_str) )
                           + sub_xform_mixed_number($v_inch_str)
                         );
      }
#     Check for no tag.
      if ($v_tag_str =~ /none/i){
         $v_tag = "";
      } else {
         $v_tag = $v_tag_str;
      }
   } else {
      $v_border_id = "";
      $v_dim1_total = 0;
      $v_dim2_total = 0;
      $v_tag = "";
   }

   RETURN $v_dim1_total;
$BODY$
  LANGUAGE 'plperl' STABLE STRICT;

pgsql-novice by date:

Previous
From: "Keith Worthington"
Date:
Subject: Upgrade from 8.0.0 to 8.0.2
Next
From: Volkan YAZICI
Date:
Subject: lo_creat SQL command