Velocity Reviews - Computer Hardware Reviews

Velocity Reviews > Newsgroups > Programming > Perl > Perl Misc > Need help/advice to improve script

Reply
Thread Tools

Need help/advice to improve script

 
 
sopan.shewale@gmail.com
Guest
Posts: n/a
 
      07-21-2010
Hello,

I have Apache htpasswd format password store. The fields are ":"
separated and has more fields than standard format. I have script to
read the fields and load into Hash.

I need advice/help to improve the script. The current one works-but
not really good script. The script goes as follow:
--------------------------------
#!/usr/bin/perl
use strict;
use warnings;

my $data = {};

for (<DATA>) {

my $line = $_;
if ( defined $line ) {
if ( $line =~ /^(.*?).*?).*?).*?).*?)(?:.*))?$/
|| $line =~ /^(.*?).*?).*?).*?)(?:.*))?$/
|| $line =~ /^(.*?).*?).*?)(?:.*))?$/
|| $line =~ /^(.*?).*?)(?:.*))?$/ )
{
$data->{$1}->{pass} = $2;
$data->{$1}->{emails} = $3 || '';
$data->{$1}->{flag} =
( ( defined $4 ) && ( $4 == 0 ) ) ? 0 : ( $4 || '' );
$data->{$1}->{pass_change} = $5 || '';
$data->{$1}->{flag_change} = $6 || '';
}
}

}

use Data:umper;
print Data:umper->Dump( [$data] );

__DATA__
AllPresent:hjliEO35kCgwI:(E-Mail Removed):1:23232:2 4324
LastMissing:CyL92g3OKi.jM:(E-Mail Removed): 1:2323
FlagZero:CyL92g3OKi.jM:(E-Mail Removed):0:2323 2
OnlyFlag:ZuqpLZ7AxHBvw(E-Mail Removed):0
RestMissing:ZuqpLZ7AxHBvw:(E-Mail Removed)

-------------------------
Please note - only first two fields are must fields, rest may be
missing from lines. first is - username, second is encrypted
password, third is email, fourth is flag to force user to change
password(0-pass change is not required, 1-user must change pass),
fifth- the last time password changed epoch time, sixth- time of
change of flag (some times flag is changed by admins of the system).

thanks in advance
 
Reply With Quote
 
 
 
 
Martijn Lievaart
Guest
Posts: n/a
 
      07-21-2010
On Wed, 21 Jul 2010 02:17:20 -0700, http://www.velocityreviews.com/forums/(E-Mail Removed) wrote:

> Hello,
>
> I have Apache htpasswd format password store. The fields are ":"
> separated and has more fields than standard format. I have script to
> read the fields and load into Hash.
>
> I need advice/help to improve the script. The current one works-but not
> really good script. The script goes as follow:
> --------------------------------
> #!/usr/bin/perl
> use strict;
> use warnings;
>
> my $data = {};


Simpler to use a hash variable, if needed you can always take a reference
to that.

>
> for (<DATA>) {


While (<...>) has magic, use it.

>
> my $line = $_;
> if ( defined $line ) {
> if ( $line =~ /^(.*?).*?).*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?).*?).*?)(?:.*))?$/ || $line
> =~ /^(.*?).*?).*?)(?:.*))?$/ || $line =~
> /^(.*?).*?)(?:.*))?$/ )


This is why split() was invented

> {
> $data->{$1}->{pass} = $2;
> $data->{$1}->{emails} = $3 || '';
> $data->{$1}->{flag} =
> ( ( defined $4 ) && ( $4 == 0 ) ) ? 0 : ( $4 || '' );
> $data->{$1}->{pass_change} = $5 || '';
> $data->{$1}->{flag_change} = $6 || '';
> }
> }
>
> }
>


#!/usr/bin/perl
use strict;
use warnings;

my %data;

while (my $line = <DATA>) {
# chop of newline
chomp $line;
# split into fields
my ($user, $pass, $email, $flag, $passchange, $flagchange) =
split /:/, $line, 6;
# stuff into hash, using a hash slice
@{$data{$user}}{qw/pass email flag passchange flagchange/} =
($pass, $email, $flag, $passchange, $flagchange);
}

use Data:umper;
print Data:umper->Dump( [\%data] );

__DATA__
AllPresent:hjliEO35kCgwI:(E-Mail Removed):1:23232:2 4324
LastMissing:CyL92g3OKi.jM:(E-Mail Removed): 1:2323
FlagZero:CyL92g3OKi.jM:(E-Mail Removed):0:2323 2
OnlyFlag:ZuqpLZ7AxHBvw(E-Mail Removed):0
RestMissing:ZuqpLZ7AxHBvw:(E-Mail Removed)


The line with he hash slice can also be written as:
$data{$user}{pass} = $pass;
$data{$user}{email} = $email;
... etc ...

And obviously, it can even be shortened to:
# split and stuff into hash, using a hash slice
@{$data{$user}}{qw/pass email flag passchange flagchange/} =
split /:/, $line, 6;

HTH,
M4
 
Reply With Quote
 
 
 
 
Jrgen Exner
Guest
Posts: n/a
 
      07-21-2010
"(E-Mail Removed)" <(E-Mail Removed)> wrote:
>Hello,
>
>I have Apache htpasswd format password store. The fields are ":"
>separated and has more fields than standard format. I have script to
>read the fields and load into Hash.
>
>I need advice/help to improve the script. The current one works-but
>not really good script. The script goes as follow:
>--------------------------------
>#!/usr/bin/perl
>use strict;
>use warnings;


Good!

>my $data = {};


This is confusing. Is $data a reference to an anonymous hash? The length
of an empty anonymous hash? Are you using curly brackets instead of
regular quotes? Is this a typo and you meant %data instead?

Whatever it is, such a non-standard use is very confusing and also
totally unnecessary because Perl will initialize variables to 'emtpy'
anyway.

>for (<DATA>) {


This doesn't make much sense. for() creates the whole argument list
first. So either just read the whole file into a array or use while() to
process it line by line.

> my $line = $_;
> if ( defined $line ) {


The test is unnecessary. If the line was read from the file then the
variable is defined.

> if ( $line =~ /^(.*?).*?).*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?)(?:.*))?$/ )


OMG! If your data is colon-separated then just split() it at the colon
and check how many elements the result array has.
@fields = split /:/, $line;
if (@fields > 2 and @fields < {
or something similar.

jue
 
Reply With Quote
 
Peter J. Holzer
Guest
Posts: n/a
 
      07-21-2010
On 2010-07-21 09:17, (E-Mail Removed) <(E-Mail Removed)> wrote:
> Hello,
>
> I have Apache htpasswd format password store. The fields are ":"
> separated and has more fields than standard format. I have script to
> read the fields and load into Hash.
>
> I need advice/help to improve the script. The current one works-but
> not really good script. The script goes as follow:
> --------------------------------
> #!/usr/bin/perl
> use strict;
> use warnings;
>
> my $data = {};
>


> for (<DATA>) {
> my $line = $_;


Change these two lines to

while (my $line = <DATA>) {


> if ( defined $line ) {


$line is always defined here so remove this line.

> if ( $line =~ /^(.*?).*?).*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?)(?:.*))?$/ )
> {


That looks extremely convoluted. I didn't even try to understand what
this does. Each line is a colon-separated list of fields, isn't it?
So replace it with:

chomp($line);
my ($username, $pass, $emails, $flag, $pass_change, $flag_change)
= split(/:/, $line);
next unless $pass;

and then use $username, $pass, etc. instead of $1, $2, etc.

> $data->{$1}->{pass} = $2;
> $data->{$1}->{emails} = $3 || '';
> $data->{$1}->{flag} =
> ( ( defined $4 ) && ( $4 == 0 ) ) ? 0 : ( $4 || '' );


This could be written somewhat more readable as:

$data->{$username}->{flag} = defined $flag ? $flag : '';

or if you have Perl 5.10, as

$data->{$username}->{flag} = $flag // '';

And since this is a flag it should probably only be used in a boolean
context, so it doesn't matter whether the value is 0, '' or undef, so
I would just write

$data->{$username}->{flag} = $flag;

instead.

> $data->{$1}->{pass_change} = $5 || '';
> $data->{$1}->{flag_change} = $6 || '';


And these are numeric values. 0 may be a valid value, so replacing it
with '' may be an error. Even if it isn't, I'd prefer undef for invalid
values over '', I'd just write

$data->{$username}->{pass_change} = $pass_change;
$data->{$username}->{flag_change} = $flag_change;

here, too.


Finally, the long list of assignments bothers me. So I'd rewrite that to

$data->{$username}
= {
pass => $pass,
emails => $emails || '',
flag => $flag,
pass_change => $pass_change,
flag_change => $flag_change,
};

and the duplication of fieldnames could also be avoided:

my @field_names = qw(pass emails flag pass_change flag_change);
my ($username, @field_values) = split(/:/, $line);
@{ $data->{$username} }{@field_names} = @field_values;

if we can live with an undefined 'emails' field.

> }
> }
>
> }
>
> use Data:umper;
> print Data:umper->Dump( [$data] );
>
> __DATA__
> AllPresent:hjliEO35kCgwI:(E-Mail Removed):1:23232:2 4324
> LastMissing:CyL92g3OKi.jM:(E-Mail Removed): 1:2323
> FlagZero:CyL92g3OKi.jM:(E-Mail Removed):0:2323 2
> OnlyFlag:ZuqpLZ7AxHBvw(E-Mail Removed):0
> RestMissing:ZuqpLZ7AxHBvw:(E-Mail Removed)
>


So my final script looks like this:


#!/usr/bin/perl
use strict;
use warnings;

my $data = {};

while (my $line = <DATA>) {
chomp $line;
my @field_names = qw(pass emails flag pass_change flag_change);
my ($username, @field_values) = split(/:/, $line);
next unless $username;
@{ $data->{$username} }{@field_names} = @field_values;
}

use Data:umper;
print Data:umper->Dump( [$data] );

__DATA__
AllPresent:hjliEO35kCgwI:(E-Mail Removed):1:23232:2 4324
LastMissing:CyL92g3OKi.jM:(E-Mail Removed): 1:2323
FlagZero:CyL92g3OKi.jM:(E-Mail Removed):0:2323 2
OnlyFlag:ZuqpLZ7AxHBvw(E-Mail Removed):0
RestMissing:ZuqpLZ7AxHBvw:(E-Mail Removed)

hp
 
Reply With Quote
 
Peter J. Holzer
Guest
Posts: n/a
 
      07-21-2010
On 2010-07-21 12:31, Jürgen Exner <(E-Mail Removed)> wrote:
> "(E-Mail Removed)" <(E-Mail Removed)> wrote:
>>my $data = {};

>
> This is confusing.


I don't think so. It's perfectly clear and normal Perl.

> Is $data a reference to an anonymous hash?


Yes.

> The length
> of an empty anonymous hash?


No.

> Are you using curly brackets instead of
> regular quotes?


No. Of course he could have meant to write
my $data = q{};
but there is no reason to assume that.

> Is this a typo and you meant %data instead?


Then he would also have had to use parentheses instead of the braces.
So this is unlikely.


> Whatever it is, such a non-standard use is very confusing and also
> totally unnecessary because Perl will initialize variables to 'emtpy'
> anyway.


But “empty” (you mean “undef”) isn't the same as a reference to an empty
hash. It makes no difference in this program (the anonymous hash is
autovivified at the first access), but an explicit initialization like
this:

* Serves as a reminder that this variable is intended to be used as a
hashref (and not as an arrayref, string, number, or whatever)
* May catch some usage errors
* May prevent autovivification at the wrong place. For example,
my $data; func($data);
is not the same as
my $data = {}; func($data);
if func() accesses $data->{something}.

So it's sometimes necessary, often useful and otherwise harmless.

hp

 
Reply With Quote
 
Dr.Ruud
Guest
Posts: n/a
 
      07-21-2010
Peter J. Holzer wrote:

> But “empty” (you mean “undef”) isn't the same as a reference to an empty
> hash. It makes no difference in this program (the anonymous hash is
> autovivified at the first access), but an explicit initialization like
> this:
>
> * Serves as a reminder that this variable is intended to be used as a
> hashref (and not as an arrayref, string, number, or whatever)
> * May catch some usage errors
> * May prevent autovivification at the wrong place. For example,
> my $data; func($data);
> is not the same as
> my $data = {}; func($data);
> if func() accesses $data->{something}.
>
> So it's sometimes necessary, often useful and otherwise harmless.


I also, and pretty often, use it in this way:

my $dfbb = $data{ foo }{ bar }{ baz } ||= {};

--
Ruud
 
Reply With Quote
 
Dr.Ruud
Guest
Posts: n/a
 
      07-21-2010
Peter J. Holzer wrote:

> my ($username, $pass, $emails, $flag, $pass_change, $flag_change)
> = split(/:/, $line);


Variant:

my %line;
@line{qw/ pass emails flag pass_change flag_change /} =
split /:/, $line;

--
Ruud
 
Reply With Quote
 
sln@netherlands.com
Guest
Posts: n/a
 
      07-21-2010
On Wed, 21 Jul 2010 02:17:20 -0700 (PDT), "(E-Mail Removed)" <(E-Mail Removed)> wrote:

>Hello,
>
>I have Apache htpasswd format password store. The fields are ":"
>separated and has more fields than standard format. I have script to
>read the fields and load into Hash.
>
>I need advice/help to improve the script. The current one works-but
>not really good script. The script goes as follow:
>--------------------------------
>#!/usr/bin/perl
>use strict;
>use warnings;
>
>my $data = {};
>
>for (<DATA>) {
>
> my $line = $_;
> if ( defined $line ) {
> if ( $line =~ /^(.*?).*?).*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?).*?)(?:.*))?$/
> || $line =~ /^(.*?).*?)(?:.*))?$/ )
> {
> $data->{$1}->{pass} = $2;
> $data->{$1}->{emails} = $3 || '';
> $data->{$1}->{flag} =
> ( ( defined $4 ) && ( $4 == 0 ) ) ? 0 : ( $4 || '' );
> $data->{$1}->{pass_change} = $5 || '';
> $data->{$1}->{flag_change} = $6 || '';
> }
> }
>
>}
>
>use Data:umper;
>print Data:umper->Dump( [$data] );
>
>__DATA__
>AllPresent:hjliEO35kCgwI:(E-Mail Removed):1:23232: 24324
>LastMissing:CyL92g3OKi.jM:(E-Mail Removed) :1:2323
>FlagZero:CyL92g3OKi.jM:(E-Mail Removed):0:232 32
>OnlyFlag:ZuqpLZ7AxHBvw(E-Mail Removed):0
>RestMissing:ZuqpLZ7AxHBvw:(E-Mail Removed)
>
>-------------------------
>Please note - only first two fields are must fields, rest may be
>missing from lines. first is - username, second is encrypted
>password, third is email, fourth is flag to force user to change
>password(0-pass change is not required, 1-user must change pass),
>fifth- the last time password changed epoch time, sixth- time of
>change of flag (some times flag is changed by admins of the system).
>
>thanks in advance


use strict;
use warnings;

my $data = {};

for (<DATA>) {

# ^^ Why for ?

my $line = $_;
if ( defined $line ) {
if (
# $line =~ /^ (.*?) : (.*?) : (.*?) : (.*?) : (.*?) (?: : (.*) ) ? $ /x
# || $line =~ /^ (.*?) : (.*?) : (.*?) : (.*?) (?: : (.*) ) ? $ /x
# || $line =~ /^ (.*?) : (.*?) : (.*?) (?: : (.*) ) ? $ /x
# || $line =~ /^ (.*?) : (.*?) (?: : (.*) ) ? $ /x )

# ^^ Replace with this ->
$line =~ /^ (.*?) .*?) (?:.*?))? (?:.*?))? (?:.*?))? (?:.*))? $ /x

# Here, be more proactive, expect certain class of values with a length
# Should 'if()' fail, send the line to a log file, don't clutter the hash

)
{
# Validate more stuff, at least check that $1 is > ''

$data->{$1}->{pass} = $2;
# ^^ could be '' then key is ''

$data->{$1}->{emails} = $3 || '';
$data->{$1}->{flag} =
( ( defined $4 ) && ( $4 == 0 ) ) ? 0 : ( $4 || '' );
# ^^ What if $4 is alpha-num ? Throws a warning
# Consolidate the above logic !

$data->{$1}->{pass_change} = $5 || '';
$data->{$1}->{flag_change} = $6 || '';
}
}

}

### ^^^^
### Would 'split()' be more affective ??


use Data:umper;
print Data:umper->Dump( [$data] );

__DATA__
AllPresent:hjliEO35kCgwI:(E-Mail Removed):1:23232:2 4324
LastMissing:CyL92g3OKi.jM:(E-Mail Removed): 1:2323
FlagZero:CyL92g3OKi.jM:(E-Mail Removed):0:2323 2
OnlyFlag:ZuqpLZ7AxHBvw(E-Mail Removed):0
RestMissing:ZuqpLZ7AxHBvw:(E-Mail Removed)
:::asdf:

-sln
 
Reply With Quote
 
sln@netherlands.com
Guest
Posts: n/a
 
      07-21-2010
On Wed, 21 Jul 2010 16:30:43 -0700, (E-Mail Removed) wrote:

>On Wed, 21 Jul 2010 02:17:20 -0700 (PDT), "(E-Mail Removed)" <(E-Mail Removed)> wrote:
>
>>Hello,
>>
>>I have Apache htpasswd format password store. The fields are ":"
>>separated and has more fields than standard format. I have script to
>>read the fields and load into Hash.
>>
>>I need advice/help to improve the script. The current one works-but
>>not really good script. The script goes as follow:
>>--------------------------------
>>#!/usr/bin/perl
>>use strict;
>>use warnings;
>>
>>my $data = {};
>>
>>for (<DATA>) {
>>
>> my $line = $_;
>> if ( defined $line ) {
>> if ( $line =~ /^(.*?).*?).*?).*?).*?)(?:.*))?$/
>> || $line =~ /^(.*?).*?).*?).*?)(?:.*))?$/
>> || $line =~ /^(.*?).*?).*?)(?:.*))?$/
>> || $line =~ /^(.*?).*?)(?:.*))?$/ )
>> {
>> $data->{$1}->{pass} = $2;
>> $data->{$1}->{emails} = $3 || '';
>> $data->{$1}->{flag} =
>> ( ( defined $4 ) && ( $4 == 0 ) ) ? 0 : ( $4 || '' );
>> $data->{$1}->{pass_change} = $5 || '';
>> $data->{$1}->{flag_change} = $6 || '';
>> }
>> }
>>
>>}
>>
>>use Data:umper;
>>print Data:umper->Dump( [$data] );
>>
>>__DATA__
>>AllPresent:hjliEO35kCgwI:(E-Mail Removed):1:23232 :24324
>>LastMissing:CyL92g3OKi.jM:(E-Mail Removed) m:1:2323
>>FlagZero:CyL92g3OKi.jM:(E-Mail Removed):0:23 232
>>OnlyFlag:ZuqpLZ7AxHBvw(E-Mail Removed):0
>>RestMissing:ZuqpLZ7AxHBvw:(E-Mail Removed)
>>
>>-------------------------
>>Please note - only first two fields are must fields, rest may be
>>missing from lines. first is - username, second is encrypted
>>password, third is email, fourth is flag to force user to change
>>password(0-pass change is not required, 1-user must change pass),
>>fifth- the last time password changed epoch time, sixth- time of
>>change of flag (some times flag is changed by admins of the system).
>>
>>thanks in advance

>
>use strict;
>use warnings;
>
>my $data = {};
>
>for (<DATA>) {
>

[snip]

Oh, and the array primary keys are suseptible to bein overwritten as your
list processes.

-sln
 
Reply With Quote
 
sln@netherlands.com
Guest
Posts: n/a
 
      07-21-2010
On Wed, 21 Jul 2010 19:54:36 +0200, "Dr.Ruud" <(E-Mail Removed)> wrote:

>Peter J. Holzer wrote:
>
>> But empty (you mean undef) isn't the same as a reference to an empty
>> hash. It makes no difference in this program (the anonymous hash is
>> autovivified at the first access), but an explicit initialization like
>> this:
>>
>> * Serves as a reminder that this variable is intended to be used as a
>> hashref (and not as an arrayref, string, number, or whatever)
>> * May catch some usage errors
>> * May prevent autovivification at the wrong place. For example,
>> my $data; func($data);
>> is not the same as
>> my $data = {}; func($data);
>> if func() accesses $data->{something}.
>>
>> So it's sometimes necessary, often useful and otherwise harmless.

>
>I also, and pretty often, use it in this way:
>
> my $dfbb = $data{ foo }{ bar }{ baz } ||= {};


If I have to spend more than 3 seconds understanding a line of
Perl that isin't a regular expression, I pass it by.

-sln
 
Reply With Quote
 
 
 
Reply

Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Silly li'l perl script, plx improve. George Orwell Perl Misc 5 01-04-2007 04:44 PM
Need advice on how to improve this function Matthew Wilson Python 3 08-22-2006 05:13 PM
Can i improve this function?i need your help... gbattine Java 8 07-16-2006 12:36 PM
how to improve simple python shell script (to compile list of files) Jari Aalto Python 4 10-15-2005 06:48 PM
Need to Improve my skill set in C Anand C Programming 3 01-11-2004 03:58 PM



Advertisments