WordPress.org

Ready to get started?Download WordPress

Forums

Perl redirect no longer working (1 post)

  1. candice_t
    Member
    Posted 1 year ago #

    Hi everyone,

    Hoping someone might be able to point me in the right direction. About a month ago, my team moved our site from a custom CMS over to WordPress.org. The site had been up for almost 10 years, with literally thousands of pages of content (it's an online magazine). The old version had URLs that were just sequential strings of numbers, and the new URLs created through WP are based on the article titles. We didn't want any of the old URLs that might be linked/bookmarked anywhere to stop working after the switch over, so we wrote a redirector.pl file that would do the following:

    Example:
    http://www.treblezine.com/columns/236.html
    redirects to
    http://www.treblezine.com/top-10-metal-albums-of-2012/

    The script has been running fine for a few weeks, but today it seems to have stopped working. None of us have changed the .pl file. None of us have changed how WP is structuring the URLs. The only changes I've made at all this weekend are placing a new iTunes ad on the homepage and adding a caching plugin because our site has been loading slowly. I removed the caching plugin on the chance that might be the cause, but that didn't solve it.

    Anyone know why this might be happening?

    Here is what's in the .pl file, if it helps:

    #!/usr/bin/perl -w
    
    use strict;
    use CGI;
    use DBI;
    
    my $foo = CGI->new->url(); # get my URL
    
    if ($foo =~ /reviews/) {
    
      $foo =~ s/_+/-/g; # consolidate one or more underscore into a single hyphen
      $foo =~ s/(.*\/reviews\/)(\d+\-)(.*)(\.html)/$1$3\//; # ditch the ID and the .html
    
      # the following special cases need to be fixed if the contraction is the final word in the title
      # TODO
    
      $foo =~ s/-t-/t-/g; # solves can't won't don't etc
      $foo =~ s/_s_/s-/g; # solves it's joe's etc
      $foo =~ s/_d_/d-/g; # solves it'd
      $foo =~ s/_ve_/ve_/g; # solves should've
      $foo =~ s/\/-/\//g; # solves trailing dashes
      $foo =~ s/\-\//\//g; # solves leading dashes
    
    } elsif ($foo =~ /columns/) {
        $foo =~ s/(\d+)\.html//;  # grab the id
        my $id = $1;
    
        my $dbh = get_dbh();
        my $sql = "SELECT title from column_articles WHERE column_article_id = ?";
        my $sth = $dbh->prepare($sql);
        $sth->execute($id);
    
        my $result = $sth->fetchrow_arrayref();
        my $title = $result->[0];
        $title =~ s/[^a-zA-Z0-9-]/-/g;
        $foo =~ s/columns\///g;
        $foo = $foo . $title . "/";
    
        #print "Content-type: text/plain\n\n";
        #print "$foo COLUMN # $id : $title\n\n";
    
    } elsif ($foo =~ /features/) {
        $foo =~ s/(\d+)\.html//;  # grab the id
        my $id = $1;
    
        my $dbh = get_dbh();
        my $sql = "SELECT title from features WHERE feature_id = ?";
        my $sth = $dbh->prepare($sql);
        $sth->execute($id);
    
        my $result = $sth->fetchrow_arrayref();
        my $title = $result->[0];
        $title =~ s/[^a-zA-Z0-9-]/-/g;
        $foo =~ s/features\///g;
        $foo = $foo . $title . "/";
    
        #print "Content-type: text/plain\n\n";
        #print "$foo COLUMN # $id : $title\n\n";
    }
    
    sub get_dbh {
      my $dbh = DBI->connect("DBI:mysql:host=mysql.treblezine.com;database=db110600_treble", 'jterich', 'Treble1981')
          or die "Couldn't connect to the database!\n$DBI::errstr";
    
      return $dbh;
    }
    
    #print "Content-type: text/plain\n\n";
    print "Location: " . lc($foo) . "\n\n";  
    
    # if its a column or feature:
    
    # connect to the OLD treble database
    # look up the title
    # rebuild the url
    # redirect

Topic Closed

This topic has been closed to new replies.

About this Topic