sub get_udx_media_relations {
    my $SupplierID = shift;
    my $SupplierPID = shift;
    my $return;
    my $query = qq|SELECT
      ProviderID,
      SourceID,
      Folder,
      Filename,
      Extension,
      Purpose,
      Rank,
      Priority,
      Width,
      Height
      FROM CT_Media_Relations
      WHERE SupplierID = '$SupplierID'
      AND SupplierPID = '$SupplierPID'
      AND isDeleted != 'Yes'
      GROUP BY Filename, Extension
      ORDER BY Priority DESC, Rank ASC|;
[download]

No placeholders here. That prevents DBI, DBD and the database itself from caching the query, so it has to be parsed again from zero each and every time. Even if you only change the IDs. Using placeholders and prepare_cached() instead of prepare() could improve speed, at least when used in a persistent environment (i.e. mod_perl, FastCGI, basically everything but plain old CGI). And, even worse, you might become a victim of SQL injection. See https://bobby-tables.com/.

    while ($_ = $sth->fetchrow_hashref) {
        if ($prev_priority->{$_->{Purpose}} > $_->{Priority}) {
            next unless $_->{Purpose} eq 'PDB';
        }
        #get rid of mds when manufacturer is present (4 vs 5)
        if ($_->{Purpose} eq 'AAB'
          or $_->{Purpose} eq 'EBD'
          or $_->{Purpose} eq 'PBS'
          or $_->{Purpose} eq 'PRI') {
            if ($prev_priority->{IMG} > $_->{Priority}) {
                next;
            }
            else {
                $prev_priority->{IMG} = $_->{Priority};
            }
        }
        $prev_priority->{$_->{Purpose}} = $_->{Priority};
        if ($_->{Purpose} eq 'PRI' && !$return->{Primary}->{path}) {
            $return->{Primary} = $_;
            $return->{Primary}->{path} = '/dx/' . $_->{ProviderID}
              . "/" . $_->{SourceID};
            $return->{Primary}->{filename} = $_->{Filename}
              . '.' . $_->{Extension};
            $return->{Primary}->{filename} = $_->{Folder} . '/'
              . $return->{Primary}->{filename} if $_->{Folder};
        }
        my $media = $_;
        $media->{path} = '/dx/' . $_->{ProviderID} 
          . "/" . $_->{SourceID};
        $media->{filename} = $_->{Filename} 
          . '.' . $_->{Extension};
        $media->{filename} = $_->{Folder} 
          . '/' . $media->{filename} if $_->{Folder};
        push(@{$return->{$_->{Purpose}}}, $media);
    }
[download]

I did not even try to fully understand what happens here. But you are fetching data from the database just to discard it, based on values of the "Purpose" and "Priority" columns. That won't speed up things. Try not to fetch data that you don't need. Make the database filter out everything you don't need, i.e. put your criteria into the WHERE condition. That way, the database won't have to find data you don't need, fetch it, serialize it, and push it through the connection to your application where the DBD has to deserialize it, and all of that just to discard that unwanted data.

If the remaining code looks similar, that's where you can really improve performance. Use placeholders everywhere to allow at least the database to cache queries, and filter in the database, not in perl.

Alexander

Thank you very much for your feedback.

The effect of placeholder and caching was new to me but makes sense.
I will take a closer look at that hoping that speedycgi already does something there for I still fear the use of mod_perl with my code.

For the security issue you are right in general but in this case I think there is no risk because only INT requests from the product data find their way to this subroutine. Nevertheless I will clean up my stuff with placeholders which seem to be better in any way.

I will also rethink the logic in this operation. The big but is that I do have categories of images (single, item in use, primary) and several sources for images where one can have one or more categories of images. I want to display the image group with the highest priority for every category and discard the rest. If a product is edited by staff I still want to access all available images which could result in an editorial pick for every image category. A small part of the idea is the following:

AAB (product in use) could be two images from source with Priority 5
EBD (single product image) could be three images which shows the product from different views
PRI (primary image) if not defined the first image from EBD should be taken

I start do doubt what I am doing is clever even with prices where I originally thought the way is obvious:

sub get_Price {
    my $SupplierID = shift;
    my $SupplierPID = shift;
    # tax type 0,1,2 which could be different
    # depending on the country of the shop
    my $Tax = shift;
    
    # could be e.g. buying price or selling price
    my $Price_Type = shift;
    
    #if the request comes from a basket with amount in basket
    my $amount = shift || 0;
    
    #clientID is the shop/market
    my $ClientID = $STASH{ClientID};
    my $return;
    my $cond = GX::SQL::Condition->new();
    $cond->add("ClientID",'=',$ClientID);
    my $customer_cond = GX::SQL::Condition->new();
    
    # customerID 10000 is a dummy for public prices
    $customer_cond->add("CustomerID",'=',10000);
    
    # if there are individual prices they are also considered
    $customer_cond->add("CustomerID",'=',$STASH{account}->{ID})
      if $STASH{account}->{ID};
    
    $customer_cond->bool('OR');
    $cond->add($customer_cond);
    $cond->add("SupplierID",'=',$SupplierID);
    $cond->add("SupplierPID",'=',$SupplierPID);
    $cond->add("Price_Type",'=',$Price_Type);
    $cond->bool('AND');
    
    my @prices;
    my $previous_price;
    
    my $udx_prices = $DB->table('UDX_Prices');
    $udx_prices->select_options ("ORDER BY Amount ASC, Price ASC");
    my $sth = $udx_prices->select(['
        Price_Type,
        Amount,
        Price,
        Discount,
        Rebate,
        Currency,
        Price_Quantity'], $cond);
        
    while (my $_ = $sth->fetchrow_hashref) {
        #calculate customer discount in percent if available
        $_->{Price_Discount} = sprintf("%0.2f", ($_->{Price} *
          ( $STASH{account}->{Discount} ) / 100));
        $_->{Price} = sprintf("%0.2f", ($_->{Price} -
          $_->{Price_Discount} ));

        my ($new_price,$old_price);
        $old_price = $_->{Price} * 100 / $_->{Price_Quantity};
        $_->{Price} = sprintf("%0.2f", ($_->{Price}) /
          $_->{Price_Quantity});

        $new_price = $_->{Price} * 100;
        if ($old_price == $new_price) {
            $_->{Price_Quantity} = 1;
        }
        else {
            $_->{Price} = sprintf("%0.2f", ($old_price / 100));
        }
        
        # if the previous price is smaller skip the price
        if ($previous_price->{Price} &&
          $previous_price->{Price} <= $_->{Price}) {
            next;
        }
        
        # if the amount is the same as before skip the price
        next if $previous_price->{Amount} == $_->{Amount};
        $_->{Tax} = $STASH{shop}->{'Local_Tax' . $Tax};
        $_->{Gross_Price} = sprintf("%0.2f", ($_->{Price} *
          (100 + $STASH{shop}->{'Local_Tax' . $Tax}) / 100));
        $_->{Tara} = 
          sprintf("%0.2f", ($_->{Gross_Price} - $_->{Price}));

        $previous_price = $_;
        push @prices, $_;
    }
    $return->{prices} = \@prices;
    return $return;
}
[download]

I order the prices by amount and price. If an amount equals the previous amount the price will be skipped and if a price is higher than the prevoius price it will be skipped either. First could occur based on rounding and calculation, the second should not happen but gives me some kind of security.

As said, I am happy for your input because it makes me question myself and brings up new ideas for me.

Cheers derion

For the security issue you are right in general but in this case I think there is no risk because

If only I had a penny for every time someone said this and was subsequently pwned because the risk turned out to be non-zero after all.

---

🦛