for each statement help needed 3

[oshjosh]

Hi I need some help if possible please.. the script below uses a flat file database and prints an artists name and then the records listed for that artist, which is exactly what I want it to do..

However each time a new artist is added to the database I have to do a new for each statement.

Is there any way I can make it look for the artist from the $artist fields print that artists name then do a for each statement automatically so that I dont have to add one to the script manualy each time.

I think my way the script will also get very slow as the number of artists increases.. as you can probably guess Im not a perl programmer as much as a fiddler but I am trying to learn..

Thanks in advance
Rob


#!/usr/bin/perl
use CGI;
$req = new CGI;
$datadir = "/home/

http://www/shopinfo";

open(FILE,"$datadir/data.log"
@data = <FILE>;
close(FILE);
print &quot;content-type:text/html\n\n&quot;;
$num = @data;
$result=0; $i=0; $j=0; $a=0;
foreach $data (@data) {
($id,$simage,$bimage,$artist,$ref,$size,$desc,$price,$title,$display) = split(/::/, $data);
if ($artist eq &quot;Jean-Michel-Basquiat&quot {
$result++;
}
}
$page = $req->param('page');
if ($page eq '') { $page=0;}
else { $line = $page*100; }
if ($page ==0) {

#start asrtist
print &quot;<br><br>Jean-Michel-Basquiat<br>&quot;;
print &quot;<table cellpadding=0 cellspacing=0 width=100%>&quot;;
foreach $data (@data) {
($id,$simage,$bimage,$artist,$ref,$size,$desc,$price,$title,$display) = split(/::/, $data);
if ($artist eq &quot;Jean-Michel-Basquiat&quot {
$i++;$j++;
if ($j <= 100) {
if ($i==1) {


print &quot;<tr>&quot;;
}
print&quot;<td width=30% align=center valign=top>&quot;;
print &quot;<span class=\&quot;menuleft\&quot;><a class=\&quot;cgilink\&quot; href=\&quot;

http://www.abacus-gallery.com/cgi-b...tion=form\&quot;>$title<a/></span><br>&quot;;

print &quot;</td>&quot;;
if ($i == 3) {
print &quot;</tr><tr height=\&quot;22\&quot;></tr>&quot;;
$i = 0;
}
} # end j <=6
else { last;}
} # end if

} # end foreach
print &quot;</table>&quot;;

print &quot;<br><br>Pablo Picasso<br>&quot;;
print &quot;<table cellpadding=0 cellspacing=0 width=100%>&quot;;
foreach $data (@data) {
($id,$simage,$bimage,$artist,$ref,$size,$desc,$price,$title,$display) = split(/::/, $data);
if ($artist eq &quot;Pablo Picasso&quot {
$i++;$j++;
if ($j <= 100) {
if ($i==1) {


print &quot;<tr>&quot;;
}
print&quot;<td width=30% align=center valign=top>&quot;;
print &quot;<span class=\&quot;menuleft\&quot;><a class=\&quot;cgilink\&quot; href=\&quot;

http://www.abacus-gallery.com/cgi-b...tion=form\&quot;>$title<a/></span><br>&quot;;

print &quot;</td>&quot;;
if ($i == 3) {
print &quot;</tr><tr height=\&quot;22\&quot;></tr>&quot;;
$i = 0;
}
} # end j <=6
else { last;}
} # end if

} # end foreach
print &quot;</table>&quot;;

} # end else

 

[JustKIDn]

Well, I don't know what your data looks like but. You could have another file say ARTIST.TXT. Open the ARTIST.TXT file and loop through that. Instead of hardcoding the artists name into the script, you'd be reading it from a file.

Or, even better, it sounds like you already have the artists name in DATA.LOG. Just read through DATA.LOG find the artist and do your printing.

Hope this helps!
tgus

____________________________
Families can be together forever...

 

[oshjosh]

Hi Tgus

Your correct the artists are listed in the data log, it is a flat text file delimetd by :: I just dont have any idea how to do it, I made this script up from another search script I had by cuttung and pasting chinks together until it worked.

If you could show me how I would be very grateful.

Thnaks

Rob

 

[oshjosh]

Hi actually the aritsts are listed but are listed each time for each record, so one artist may have 4-50 listings in data.log,

I would need to list the artist only once and then list the records for that artist..

I know how to seach data log for a record but dont know how to do a statement that would list the artists from data.log
any more help much appreciated..

Thanks Rob

 

[CharlesClarkson]

It sounds like you need a hash. A hash is like an array but the indexes can be names and you an't count on the order. Before we go much farther let me show a shortcut to getting information from the file.

Since we only need $id, $artist, and $title,

    ($id, $simage, $bimage,
     $artist, $ref, $size,
     $desc, $price, $title, $display) = split(/::/, $data);

Can be re-written as:

    my ($id, $artist, $title) = ( split /::/ )[0, 3, 8];

my

is used to limit the lifetime of a variable. It is used in conjunction with

 use strict;

. While optional, it makes writing and debugging large scripts much easier.


=======
I chose to create two hashes. One hash is

%title

. Given a title ID (

$id

),

$title{ $id }

will return the $title. This allows two different artists to have the same title.

Here's the code:

my %title;
foreach (@data) {
    my ($id, $title) = ( split /::/ )[0, 8];
    $title{ $id } = $title;
}

split /::/

is short for

split /::/, $_

.

$_

is the default variable in a foreach loop.



The other hash is

%artist

. It is a little more complicated. It is a hash of arrays (HoA). You can find more details in perldsc in your perl ditribution.

Here's the code:

my %artist;
foreach (@data) {
    my ($id, $name) = ( split /::/ )[0, 3];
    push @{ $artist{ $name } }, $id;
}

Here we use

push

to add each ID to an array called

$artist{ $name }

, where

$name

is the name of each artist.

======
We can combine the code that creates the hashes.

my ( %artist, %title );
foreach (@data) {
    my ( $id, $name, $title ) = ( split /::/ )[0, 3, 8];
    push @{ $artist{ $name } }, $id;
    $title{ $id } = $title;
}

======
To print a list of all the title IDs for Jean-Michel-Basquiat, we use:

my $name = 'Jean-Michel-Basquiat';
print "$name:\n";
foreach my $id ( @{ $artist{ $name } } ) {
    print "$id\n";
}

To print a list of all title IDs for each artist we use:

foreach my $name ( keys %artist ) {
    print "$name:\n";
    foreach my $id ( @{ $artist{ $name } } ) {
        print "\t$id\n";
    }
    print "\n";
}

To get a list of titles for each artist:

foreach my $name ( keys %artist ) {
    print "$name:\n";
    foreach my $id ( @{ $artist{ $name } } ) {
        print "\t$title{ $id }\n";
    }
    print "\n";
}

keys %artist[code] returns a list of the [b]keys[/b] in [code]%artist[code] which in this case are the names of the artists.

======
One final item before we start coding the html. It's faster to pass a reference into and out of a subroutine. While an array or a has may contain thousands to millions of items, a reference is will always be the same length. If references are confusing you, think of the pronoun [i]them[/i]. You can refer to a group of people by naming each person or by [i]refering[/i] to [i]them[/i] even if the group of people keep changing.

Here's an example:

[COLOR=blue][code]
my @array = ( 1 .. 1000000);
print count( @array );

sub count {
    my @array = @_;
    return scalar @array;
}

[/color]

The subroutine

count

returns the

scalar

value of

@array

, which happens to be its length. When we call

count

with

@array

we must pass one million items into the subroutine. With a reference we merely pass one item (the reference) to the subroutine.

my @array = ( 1 .. 1000000);
print count( \@array );

sub count {
    my $array = shift;
    return scalar @$array;
}

\@array

is a refence to

@array

and

@$array

de-references

$array

.


======
One advantage of the CGI.pm module is its ability to produce well-formed xhtml code on the fly. Here's a subroutine that uses the CGI module to generate the row code for each title.

sub table_data {

    #
    #   returns a link wrapped in <td> . . .</td> tags
    #    given an ID and a title.
    #

    my ($id, $title) = @_;

    my $req = new CGI;
    my $url = &quot;/cgi-bin/shop/shop.pl?fid=$id&cgifunction=form&quot;;

    return
        $req->td(

            $req->span({ class => 'menuleft' },

                $req->a({   class   => 'cgilink',
                            href    => $url },
                            $title,
                ),
            ),
        );
}

Here's a subroutine to handle sticking the rows into tables. It takes as input the artist's name, the number of columns in the table, an array of IDs, and the title hash. The last two items are passed as references.

sub artist_table {

    #   returns table of titles by artist given
    #    $name      the artists name
    #    $columns   columns in the table
    #    $ids       reference to ID array
    #    $title     reference to %title
    #
    my ( $name, $columns, $ids, $title ) = @_;

    #
    #   @table_data holds the <td> . . . </td>
    #       for each link for this artist
    #
    my @table_data;
    foreach my $id ( @$ids ) {
        push @table_data, table_data( $id, $title->{ $id } );
    }

    #
    #   pad @table_data with blank <td></td> to fill
    #    columns
    #   without padding, artists with less than $columns
    #    titles would end up with less than $columns
    #    columns
    #
    my $req = CGI->new;
    push @table_data,
        ( $req->td() ) x ( $columns - @table_data % $columns )
                if @table_data % $columns;


    my @table_rows;
    while ( @table_data ) {

        push @table_rows, $req->Tr( @table_data[ 0 .. $columns - 1 ] );

        @table_data = @table_data[ $columns .. $#table_data ];
    }

    return
        $req->br, $req->br, $name, $req->br,
        $req->table( @table_rows );
}

======
And here is the main routine as I tested it.

$max_titles

will limit titles for testing. Set it to 0 to allow all titles to show. $columns decides the maximum number of columns in the table.

open FILE, $file_name or die $!;
    my @data = <FILE>;
close FILE;

my ( %artist, %title );
foreach (@data) {
    my ($id, $name, $title) = ( split /::/ )[0, 3, 8];
    push @{ $artist{ $name } }, $id;
    $title{ $id } = $title;
}

my $max_titles = 0;

my $columns = 3;
my $col_width = int 100/$columns;

my $style = qq|
    table {
        width:      100%;
        padding:    0px;
    }
    td {
        width:          $col_width%;
        vert-align:     top;
        padding-bottom: 22px;
    }
|;

my $req = CGI->new;

print
    $req->header,
    $req->start_html({
        title   => 'Artist Dump',
        style   => $style,
    });

foreach my $name ( keys %artist ) {

    my @ids = @{ $artist{ $name } };
    unless ( @ids > $max_titles ) {
        @ids = @ids[ 0 ..  $max_titles ];
    }
    print
        artist_table( $name, $columns, \@ids, \%title),
        $req->br, $req->br, $req->br;
}

print $req->end_html;

HTH,

Charles K. Clarkson

 

[oshjosh]

WOW!!

Amazing thank you so much for taking the time for this response.. way over my head except for I see how you are only taking the necessary fields and then identifying them. 0 3 & 8

I have taken your routine and added the path to the file in as below, But I get just a blank page.. no titles and no results for each artist, Here is my go.. Maybe I have taken it to literally??

The other thing I can't see how I would do with it this way is to create a hyperlink for each title.. Sorry But I really am a novice however this type of response only inspires me to become more.. If you can through any more light on it I would be grateful..

Cheers
Rob

#!/usr/bin/perl
use CGI;
$req = new CGI;
open(FILE,&quot;/home/oshjosh/abacus-gallery.com/

http://www/shopinfo/data.log&quot;);

my @data = <FILE>;
close FILE;

my ( %artist, %title );
foreach (@data) {
my ($id, $name, $title) = ( split /::/ )[0, 3, 8];
push @{ $artist{ $name } }, $id;
$title{ $id } = $title;
}

my $max_titles = 0;

my $columns = 3;
my $col_width = int 100/$columns;

my $style = qq|
table {
width: 100%;
padding: 0px;
}
td {
width: $col_width%;
vert-align: top;
padding-bottom: 22px;
}
|;

my $req = CGI->new;

print
$req->header,
$req->start_html({
title => 'Artist Dump',
style => $style,
});

foreach my $name ( keys %artist ) {

my @ids = @{ $artist{ $name } };
unless ( @ids > $max_titles ) {
@ids = @ids[ 0 .. $max_titles ];
}
print
artist_table( $name, $columns, \@ids, \%title),
$req->br, $req->br, $req->br;
}

print $req->end_html;

 

[JustKIDn]

Charles,
Great answer! I knew if I just threw out the right idea, someone could give him the details. I thought it might require the use of a hash, but so far I haven't tried to tackle learning them yet. I have used them a couple of times when someone was kind enough to help me with my challenges. I just haven't taken the time to break them to see what makes them work.
I'm giving you a S T A R for that one!

Rob,
You say the results are coming out blank. Can we see a sample of your data file?
Maybe there's something in there that will help.
Also, instead of writing this out to a web page right away. You might just run it at the command prompt to see what your results are.
Even better, if your using Windows. You can download Open Perl IDE from

http://open-perl-ide.sourceforge.net/

.
It allows you to step through your code one line at a time and see what's in your variables. It's been a big help for me.
Also it would be helpful to find out if something is wrong if you use the -w. And don't forget to add use strict;

HTH

tgus

____________________________
Families can be together forever...

 

[justice41]

A note on optimiziation. You don't ever use the @data array after populating the hashes. So you waste time creating a data structure that never gets used and also waste memory storing it. Unless you use @data later in the code, it's more efficient to read in the file and populate the hashes all in one loop.

open(FILE,"/home/oshjosh/abacus-gallery.com/[URL unfurl="true"]www/shopinfo/[/URL] data.log");
my ( %artist, %title );
while (<FILE>) {
    my ($id, $name, $title) = ( split /::/ )[0, 3, 8];
    push @{ $artist{ $name } }, $id;
    $title{ $id } = $title;
}
close(FILE);

jaa

 

[CharlesClarkson]

Rob,

First, a point on security. Never post actual file paths to a public forum. Change them to something innocuous like:

data.log

.


Second, start all your web scripts with:

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;
use CGI::Carp 'fatalsToBrowser';

If

use warnings

gives an error add -w to the shebang.

#!/usr/bin/perl -w

This will send fatal errors to the browser when you're testing. You can comment them out when you're ready to let users have at it:

#use strict;
#use warnings;
#use diagnostics;
#use CGI::Carp 'fatalsToBrowser';

After you get more experienced, you can eliminate

use diagnostics

.


Third, here is the file I used for testing. See if it works for you. If it does, then your input file is different.

1::--::--::joe::--::--::--::--::All the Money::--
2::--::--::bob::--::--::--::--::One to Go::--
3::--::--::sam::--::--::--::--::All the Money::--
4::--::--::joe::--::--::--::--::Feel it::--
5::--::--::bob::--::--::--::--::Girl in Soda Glass::--
6::--::--::joe::--::--::--::--::Vase::--
7::--::--::sam::--::--::--::--::Funny Spring::--
8::--::--::joe::--::--::--::--::Feel it (Revisited)::--
9::--::--::sam::--::--::--::--::For the Fun of it::--

Fourth, never open a file without checking for errors.

$!

holds the current error message. Don't put a newline (

\n

) character after it.

my $file_name = 'data.log';
open FILE, $file_name or die "Cannot open $file_name: $!";
    my @data = <FILE>;
close FILE;

Some people do the same when closing the file.

HTH,

Charles

 

[oshjosh]

This version gives me a blank page and I have replace my data log with your data file and called it test.log

Below is the source of the page it prints... could this have something to do with the way perl is set up on my server?

Cheers
Rob

<!DOCTYPE HTML PUBLIC &quot;-//IETF//DTD HTML//EN&quot;>
<HTML><HEAD><TITLE>Artist Dump</TITLE>
<STYLE TYPE=&quot;text/css&quot;><!--

table {
width: 100%;
padding: 0px;
}
td {
width: 33%;
vert-align: top;
padding-bottom: 22px;
}

--></STYLE>
</HEAD><BODY>


#!/usr/bin/perl -w
use CGI;
$req = new CGI;
$datadir = &quot;/home/

http://www/shopinfo&quot;;

open(FILE,&quot;$datadir/test.log&quot;
my @data = <FILE>;
close FILE;

my ( %artist, %title );
foreach (@data) {
my ($id, $name, $title) = ( split /::/ )[0, 3, 8];
push @{ $artist{ $name } }, $id;
$title{ $id } = $title;
}

my $max_titles = 0;

my $columns = 3;
my $col_width = int 100/$columns;

my $style = qq|
table {
width: 100%;
padding: 0px;
}
td {
width: $col_width%;
vert-align: top;
padding-bottom: 22px;
}
|;

my $req = CGI->new;

print
$req->header,
$req->start_html({
title => 'Artist Dump',
style => $style,
});

foreach my $name ( keys %artist ) {

my @ids = @{ $artist{ $name } };
unless ( @ids > $max_titles ) {
@ids = @ids[ 0 .. $max_titles ];
}
print
artist_table( $name, $columns, \@ids, \%title),
$req->br, $req->br, $req->br;
}

print $req->end_html;

 

[CharlesClarkson]

Rob,

This is the second time you have listed the source without the subroutines. Did you put the two sub routines in your program? If you were using

strict

you would have caught this error immediately!

Here are the subs again:

sub artist_table {

    #
    #   $name       the artists name
    #   $columns    columsn in the table
    #   $ids        reference to ID array
    #   $title      reference to %title
    #
    my ( $name, $columns, $ids, $title ) = @_;

    #
    #   @table_data holds the <td> . . . </td>
    #       for each link for this artist
    #
    my @table_data;
    foreach my $id ( @$ids ) {
        push @table_data, table_data( $id, $title->{ $id } );
    }

    #
    #   pad @table_data with blank <td></td> to fill
    #    columns
    #   without padding, artists with less than $columns
    #    titles would end up with less than $columns
    #    columns
    #
    my $req = CGI->new;
    push @table_data,
        ( $req->td() ) x ( $columns - @table_data % $columns )
                if @table_data % $columns;


    my @table_rows;
    while ( @table_data ) {

        push @table_rows, $req->Tr( @table_data[ 0 .. $columns - 1 ] );

        @table_data = @table_data[ $columns .. $#table_data ];
    }

    return
        $req->br, $req->br, $name, $req->br,
        $req->table( @table_rows );
}

sub table_data {

    #
    #   returns a link wrapped in <td> . . .</td> tags
    #    given an ID and a title.
    #

    my ($id, $title) = @_;

    my $req = new CGI;
    my $url = &quot;/cgi-bin/shop/shop.pl?fid=$id&cgifunction=form&quot;;

    return
        $req->td(

            $req->span({ class => 'menuleft' },

                $req->a({   class   => 'cgilink',
                            href    => $url },
                            $title,
                ),
            ),
        );
}

HTH,

Charles

 

[justice41]

>> &quot;If you were using strict you would have caught this error immediately!&quot;

Actually, Perl throws this (fatal) error even without strict or warnings enabled. Since it's a runtime error, the script dies at the first encounter of an undefined subroutine, which explains the output that you're getting.
Adding

use CGI::Carp qw(fatalsToBrowser);

(which was recommended once before) will spit out these errors to your browser. Another option is to run the scripts from the command line to test them.

jaa

 

[oshjosh]

Charles,

Now I do feel Dumb.. sorry I dont know where to put the subroutines!!

When I used strict it gave me the compilation error.. without strict it gave me the blank page.. and I dont know how to run from the command line..

Maybe I should change from a techical user..

Cheers Rob

 

[CharlesClarkson]

Rob,

I didn't mean to make you feel dumb. Please remember that many of us were new to programming at one time. The subroutines can go anywhere you want, but are traditionally placed at the end of the program below the last line of code in the main program.


HTH,

Charles

 

[oshjosh]

You didn't make me feel Dumb, I never read your initial post properly.

I did some research today and worked out that the subroutines can go at the end and below is my latest try..

I am still getting the following error:
Execution of ./allnew.cgi aborted due to compilation errors

http://www.abacus-gallery.com/cgi-bin/shop/allnew.cgi

is the url I am testing at.

I have tried the sub routines in different places but still no joy.

I am learning a lot from this and its fun.. thanks for all the help..

I am in Thailand which is why I post at odd times, its evening here now.

Cheers
Rob

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;
use CGI::Carp 'fatalsToBrowser';
$req = new CGI;

my $file_name = '/home/oshjosh/

http://www/shopinfo/data.log';

open FILE, $file_name or die &quot;Cannot open $file_name: $!&quot;;
my @data = <FILE>;
close FILE;
my ( %artist, %title );
foreach (@data) {
my ($id, $name, $title) = ( split /::/ )[0, 3, 8];
push @{ $artist{ $name } }, $id;
$title{ $id } = $title;
}

my $max_titles = 0;

my $columns = 3;
my $col_width = int 100/$columns;

my $style = qq|
table {
width: 100%;
padding: 0px;
}
td {
width: $col_width%;
vert-align: top;
padding-bottom: 22px;
}
|;

my $req = CGI->new;

print
$req->header,
$req->start_html({
title => 'Artist Dump',
style => $style,
});

foreach my $name ( keys %artist ) {

my @ids = @{ $artist{ $name } };
unless ( @ids > $max_titles ) {
@ids = @ids[ 0 .. $max_titles ];
}
print
artist_table( $name, $columns, \@ids, \%title),
$req->br, $req->br, $req->br;
}

print $req->end_html;

sub artist_table {

#
# $name the artists name
# $columns columsn in the table
# $ids reference to ID array
# $title reference to %title
#
my ( $name, $columns, $ids, $title ) = @_;

#
# @table_data holds the <td> . . . </td>
# for each link for this artist
#
my @table_data;
foreach my $id ( @$ids ) {
push @table_data, table_data( $id, $title->{ $id } );
}

#
# pad @table_data with blank <td></td> to fill
# columns
# without padding, artists with less than $columns
# titles would end up with less than $columns
# columns
#
my $req = CGI->new;
push @table_data,
( $req->td() ) x ( $columns - @table_data % $columns )
if @table_data % $columns;


my @table_rows;
while ( @table_data ) {

push @table_rows, $req->Tr( @table_data[ 0 .. $columns - 1 ] );

@table_data = @table_data[ $columns .. $#table_data ];
}

return
$req->br, $req->br, $name, $req->br,
$req->table( @table_rows );
}

sub table_data {

#
# returns a link wrapped in <td> . . .</td> tags
# given an ID and a title.
#

my ($id, $title) = @_;

my $req = new CGI;
my $url = &quot;/cgi-bin/shop/shop.pl?fid=$id&cgifunction=form&quot;;

return
$req->td(

$req->span({ class => 'menuleft' },

$req->a({ class => 'cgilink',
href => $url },
$title,
),
),
);
}

 

[CharlesClarkson]

Rob,

You haven't loaded CGI.pm:

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;
use CGI::Carp 'fatalsToBrowser';
$req = new CGI;

Should be:

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;
use CGI::Carp 'fatalsToBrowser';

use CGI;
$req = new CGI;

Do you have a way of running your scripts from the command line (or a dos window)? It is very helpful for finding errors.


HTH,

CHarles

 

[oshjosh]

Thanks Charles

Added the extra line calling CGI PM and still getting the same error.

I do have telnet access but my knowledege is very limited and do not know how to run from the command line.

Any suggestions welcomed..

Thanks Rob

 

[justice41]

Change this line

$req = new CGI;

to

my $req = new CGI;

When use have [tt]strict[/tt] enabled all variables must be declared as my(), our(), or local().

jaa

 

[oshjosh]

That fixed.. Thanks to one and all and a very big thank you to Charles & justice

When my knowledge is sufficient I will be back to share it in the mean time I will probably be back picking everyones brains..

Cheers Rob

 

[oshjosh]

Back quicker than I expected..

I know in regular perl how to do an &quot;else if statement&quot;, however this type of perl is new to me.

Some of my listings do not have an artist so in the results from this program I get a table at the top with these listed. These are special offers and I would like the program to check if there is an artist listed before printing the data in the title sub routine..

I will play with it see what I can do but any help much appreciated..

I would also like to sort both sub routines alapabetically again I can do this in regular perl but am a little lost on this one.

Thanks again

Rob