Gossamer Forum: General: Perl Programming: need help with code

Jan 13, 2010, 2:49 PM

delicia

Enthusiast (661 posts)

Jan 13, 2010, 2:49 PM

Post #1 of 20

Shortcut

need help with code

ok, i'm posting here because it's a perl problem and there seems to be no activity on dbman board.

i'm using a subroutine to find fieldnames in a dbman cfg file. that part of cfg looks like this (excerpt):

Code:
%db_def = ( 
'Lock'                => [ 0, 'alpha',     -1,     5, 0, 'No',           ''], 
'Userid'              => [ 1, 'alpha',    5,   255, 1, '',              ''], 
'Business_name'       => [ 2, 'alpha',    20,   255, 0, '',              ''], 
'Firstname'           => [ 3, 'alpha',    20,   255, 1, '',              ''], 
'Lastname'            => [ 4, 'alpha',    20,   255, 1, '',              ''], 
... 
'Balance_due'         => [36, 'numer',     12,   10,   0,   '',  '\d+(?=\.\d\d)?$'], 
'Mgt_council'         => [37, 'alpha',    5,     3, 0, 'No',              ''], 
'Reserved'            => [38, 'alpha',     -1,     5, 0, 'xxxxx',           ''] 
);

my subroutine is not getting the first field (Lock) and it doesn't get the last two fields. i have no idea why it isn't getting the first one. i'm guessing it quits after Balance_due because of the validation expression that contains quotes and parentheses. can someone tell me how to fix the sub:

Code:
$configfile = "members.def"; 
$configfile = $db_script_path . "/" . $configfile; 
open(FILE, "<$configfile") || &cgierr("Cannot open $configfile.\n$!"); 
local $/; 
#undef $/; # commented to fix a different problem! 

while (<FILE>)  { if (/(%db_def\s+=\s+\(\s+)('.*?)(\))/s) { $fields = $2;}} 
close(FILE); 

while ($fields =~ /(\n')(\w+)(')/g) { push (@db2_cols, $2); } 
 return (@db2_cols);

please help! thanks.

Jan 14, 2010, 12:04 AM

Andy

Veteran / Moderator (18441 posts)

Jan 14, 2010, 12:04 AM

Post #2 of 20

Shortcut

Re: [delicia] need help with code In reply to

What do you see if you put this debugging code in:

Code:
use Data::Dumper; 
print Dumper(@db2_cols);

?

Cheers

Andy (mod)
andy@ultranerds.co.uk

Jan 14, 2010, 3:49 AM

neves

Novice (30 posts)

Jan 14, 2010, 3:49 AM

Post #3 of 20

Shortcut

Re: [delicia] need help with code In reply to

Hi,

the first field is missing, because $fields doesn't start with \n. The last fields are missing because \) in your regexp matches the closing bracket in '\d+(?=\.\d\d)?$'.

This should work:

Code:
local $/; 
my $file = <FILE>; 

my $lineRegExp	= qr~'([^']*)'\s*=>\s*\[\s*-?\d+,\s*'[^']*'(?:,\s*-?\d+){3}(?:,\s*'[^']*'){2}\]~; 

my $defRegExp	= qr~%db_def\s*=\s*\(((?:\s*$lineRegExp,)*\s*$lineRegExp)\s*\);~; 

my @db2_cols = (); 

if ( $file =~ /$defRegExp/osm ) { 
	my $def = $1; 

	@db2_cols = $def =~ /$lineRegExp/gsm; 
}

Merten

Jan 14, 2010, 8:17 AM

delicia

Enthusiast (661 posts)

Jan 14, 2010, 8:17 AM

Post #4 of 20

Shortcut

Re: [neves] need help with code In reply to

not pullling any fields now :( this is what i have:

Code:
; 
open(FILE, "<$configfile") || &cgierr("Cannot open $configfile.\n$!"); 
local $/; 
# commented next two because i think the new my $file replaces? 
#while (<FILE>)  { if (/(%db_def\s+=\s+\(\s+)('.*?)(\))/s) { $fields = $2;}} 
#close(FILE); 

my $file = <FILE>; 

my $lineRegExp = qr~'([^']*)'\s*=>\s*\[\s*-?\d+,\s*'[^']*'(?:,\s*-?\d+){3}(?:,\s*'[^']*'){2}\]~; 

my $defRegExp = qr~%db_def\s*=\s*\(((?:\s*$lineRegExp,)*\s*$lineRegExp)\s*\);~; 

my @db2_cols = (); 

if ( $file =~ /$defRegExp/osm ) { 
my $def = $1; 

@db2_cols = $def =~ /$lineRegExp/gsm; 
}

Jan 14, 2010, 8:18 AM

delicia

Enthusiast (661 posts)

Jan 14, 2010, 8:18 AM

Post #5 of 20

Shortcut

Re: [Andy] need help with code In reply to

dumper looks handy but i have no idea where to put it.

Last edited by:

delicia: Jan 14, 2010, 8:18 AM

Jan 14, 2010, 8:18 AM

Andy

Veteran / Moderator (18441 posts)

Jan 14, 2010, 8:18 AM

Post #6 of 20

Shortcut

Re: [delicia] need help with code In reply to

delicia wrote:

dumper looks handy but i have no idea where to put it.

Just before:

return (@db2_cols);

;)

Cheers

Andy (mod)
andy@ultranerds.co.uk

Jan 14, 2010, 8:34 AM

delicia

Enthusiast (661 posts)

Jan 14, 2010, 8:34 AM

Post #7 of 20

Shortcut

Re: [Andy] need help with code In reply to

didn't see anything so i added dumper here and that's all i see

Code:
use Data::Dumper; 
print "dumper here "; 
print Dumper(@db2_cols);

Jan 14, 2010, 8:43 AM

Andy

Veteran / Moderator (18441 posts)

Jan 14, 2010, 8:43 AM

Post #8 of 20

Shortcut

Re: [delicia] need help with code In reply to

Ok, what happens if you try this code?

Code:
$configfile = "members.def"; 
$configfile = $db_script_path . "/" . $configfile; 
open(FILE, "<$configfile") || &cgierr("Cannot open $configfile.\n$!"); 
local $/; 
#undef $/; # commented to fix a different problem! 

while (<FILE>) { if (/(%db_def\s+=\s+\(\s+)('.*?)(\))/s) { $fields = $2;}} 
close(FILE); 

my @split = split /\n/, $fields; 
foreach (@split) { 
    if ($_ =~ /'(\w+)'/) { push @db2_cols, $1; } 
}

return (@db2_cols);

Cheers

Andy (mod)
andy@ultranerds.co.uk

Jan 14, 2010, 8:50 AM

delicia

Enthusiast (661 posts)

Jan 14, 2010, 8:50 AM

Post #9 of 20

Shortcut

Re: [Andy] need help with code In reply to

that got the first field!!! but it still quits on #37 that has valid_expr

Jan 14, 2010, 8:51 AM

Andy

Veteran / Moderator (18441 posts)

Jan 14, 2010, 8:51 AM

Post #10 of 20

Shortcut

Re: [delicia] need help with code In reply to

Which one is field 37? Maybe post the full value of %db_def would help.

Cheers

Andy (mod)
andy@ultranerds.co.uk

Jan 14, 2010, 8:56 AM

delicia

Enthusiast (661 posts)

Jan 14, 2010, 8:56 AM

Post #11 of 20

Shortcut

Re: [Andy] need help with code In reply to

balance_due is the last field it gets. for Updated, i used to have get_date() and it stopped there. once i removed () it went on to balance_due.

Code:
%db_def = ( 
'Lock'                => [ 0, 'alpha',     -1,     5, 0, 'No',           ''], 
'Userid'              => [ 1, 'alpha',    5,   255, 1, '',              ''], 
'Business_name'       => [ 2, 'alpha',    20,   255, 0, '',              ''], 
'Firstname'           => [ 3, 'alpha',    20,   255, 1, '',              ''], 
'Lastname'            => [ 4, 'alpha',    20,   255, 1, '',              ''], 
'Address'             => [ 5, 'alpha',    20,   255, 0, '',              ''], 
'City'                => [ 6, 'alpha',    20,   255, 0, '',              ''], 
'State'               => [ 7, 'alpha',    2,   25, 0, '',              ''], 
'Zip'                 => [ 8, 'alpha',    10,   25, 0, '',              ''], 
'Phone_home'          => [ 9, 'alpha',    20,   25, 0, '',              ''], 
'Phone_cell'          => [10, 'alpha',    20,   25, 0, '',              ''], 
'Phone_ofc'           => [11, 'alpha',    20,   25, 0, '',              ''], 
'Email'               => [12, 'alpha',    40,   255, 0, '',              '.+@.+..+'], 
'URL'                 => [13, 'alpha',    40,   255, 0, '',                '^http://'], 
'Media'               => [14, 'alpha',    0,  1000, 0, '',                ''], 
'Month_expires'       => [15, 'alpha',    5,   3, 0, '',              ''], 
'Display'             => [16, 'alpha',    5,     4, 0, 'Yes',             ''], 
'Publicity'           => [17, 'alpha',    5,     25, 0, '',             ''], 
'Membership'          => [18, 'alpha',    5,     25, 0, '',             ''], 
'Events_Workshops'    => [19, 'alpha',    5,     25, 0, '',             ''], 
'Hospitality'         => [20, 'alpha',    5,     25, 0, '',             ''], 
'Website'             => [21, 'alpha',    5,     25, 0, '',             ''], 
'Gallery_Exhibits'    => [22, 'alpha',    5,     25, 0, '',             ''], 
'Newsletter'          => [23, 'alpha',    5,     25, 0, '',             ''], 
'Category'            => [24, 'alpha',    20,     255, 1, '',             ''], 
'KAZ_web'             => [25, 'alpha',    5,     3, 0, 'No',              ''], 
'Web_gallery'         => [26, 'alpha',    5,     3, 0, 'No',              ''], 
'Studio'              => [27, 'alpha',    5,     3, 0, 'No',              ''], 
'Updated'             => [28, 'date',     12,   55, 0, &get_date,       ''], 
'Letter'              => [29, 'alpha',    2,   1, 1, '',           '' ], 
'Words'               => [30, 'alpha',    0,  100, 0, '',                ''], 
'Contact_list'        => [31, 'alpha',    5,     3, 0, 'No',              ''], 
'Title'               => [32, 'alpha',    50,   255, 0, '',              ''], 
'Directory'           => [33, 'alpha',    5,     4, 0, 'Yes',             ''], 
'Massmail'            => [34, 'alpha',    5,     4, 0, 'No',             ''], 
'Notes'               => [35, 'alpha',    0,  1000, 0, '',                ''], 
'Balance_due'         => [36, 'numer',     12,   10,   0,   '',  '\d+(?=\.\d\d)?$'], 
'Mgt_council'         => [37, 'alpha',    5,     3, 0, 'No',              ''], 
'Reserved'            => [38, 'alpha',     -1,     5, 0, 'xxxxx',           ''] 
);

Jan 14, 2010, 9:00 AM

delicia

Enthusiast (661 posts)

Jan 14, 2010, 9:00 AM

Post #12 of 20

Shortcut

Re: [Andy] need help with code In reply to

dumper stopped at balance due also

Jan 14, 2010, 9:02 AM

Andy

Veteran / Moderator (18441 posts)

Jan 14, 2010, 9:02 AM

Post #13 of 20

Shortcut

Re: [delicia] need help with code In reply to

What happens if you change:

'\d+(?=\.\d\d)?$'],

to just:

''],

I'm wondering if its something in that regex which is stopping it in its tracks.

Cheers

Andy (mod)
andy@ultranerds.co.uk

Jan 14, 2010, 9:04 AM

Andy

Veteran / Moderator (18441 posts)

Jan 14, 2010, 9:04 AM

Post #14 of 20

Shortcut

Re: [delicia] need help with code In reply to

Before this:

my @split = split /\n/, $fields;

Try adding:

print qq|Testing balues of "$fields" <Br />|;

What does that print out?

Cheers

Andy (mod)
andy@ultranerds.co.uk

Jan 14, 2010, 9:09 AM

delicia

Enthusiast (661 posts)

Jan 14, 2010, 9:09 AM

Post #15 of 20

Shortcut

Re: [Andy] need help with code In reply to

code works fine without the valid_expr and pulls all fields. but i need valid_expr in some places.

$fields ends with

'Balance_due' => [36, 'numer', 12, 10, 0, '', '\d+(?=\.\d\d

note that it doesn't have the single quote at end of the valid_expr

aha. so $fields should pick up everything till it gets to ); but i don't know how to fix

Last edited by:

delicia: Jan 14, 2010, 9:12 AM

Jan 14, 2010, 9:18 AM

Andy

Veteran / Moderator (18441 posts)

Jan 14, 2010, 9:18 AM

Post #16 of 20

Shortcut

Re: [delicia] need help with code In reply to

Ah, looks like the ) in the regex is messing it up... try this:

while (<FILE>) { if (/(%db_def\s+=\s+$\s+)('.*?)($;)/s) { $fields = $2;}}

...hopefully that'll do the trick.

Cheers

Andy (mod)
andy@ultranerds.co.uk

Jan 14, 2010, 9:24 AM

delicia

Enthusiast (661 posts)

Jan 14, 2010, 9:24 AM

Post #17 of 20

Shortcut

Re: [Andy] need help with code In reply to

you are brilliant!!!!!!!!!! that did it. also, i just realized that i won't need this code if i switch to sql because i can define relationships.

i just received email from library that my sql book is in. so i'm off to pick it up.

thanks for all your help!!!

Jan 14, 2010, 9:26 AM

Andy

Veteran / Moderator (18441 posts)

Jan 14, 2010, 9:26 AM

Post #18 of 20

Shortcut

Re: [delicia] need help with code In reply to

NP - enjoy your reading ;)

Cheers

Andy (mod)
andy@ultranerds.co.uk

Jul 15, 2014, 11:15 AM

delicia

Enthusiast (661 posts)

Jul 15, 2014, 11:15 AM

Post #19 of 20

Shortcut

Re: [Andy] need help with code In reply to

didn't switch to sql so i have another question. is it possible to also pull info from each of the lines in the column that contains alpha, numer, date, etc? thanks

Jul 15, 2014, 11:57 AM

Andy

Veteran / Moderator (18441 posts)

Jul 15, 2014, 11:57 AM

Post #20 of 20

Shortcut

Re: [delicia] need help with code In reply to

Sorry, you'll have to refresh my mind- what are you trying to do?

Cheers

Andy (mod)
andy@ultranerds.co.uk