in reply to Re^2: puzzled by pages
in thread puzzled by pages

Perhaps this pattern is what you need. 

$server_name =~ m{
    \A                   # start of string
    .{1,3}               # 1-3 characters
    \.                   # a literal period
    product1help\.com    # literal 'product1help.com'
}xms;

[download]

If you want to know what the prefix matched actually was, use this: 

$server_name =~ m{
    \A                   # start of string
    (                    # start capture 1
        .{1,3}           # 1-3 characters
    )                    # end capture 1
    \.                   # a literal period
    product1help\.com    # literal 'product1help.com'
}xms;
my $prefix = $1;

[download]

Replies are listed 'Best First'.
Re^4: puzzled by pages
by grashoper (Monk) on Jun 11, 2008 at 04:06 UTC
    I don't understand why this is not working, if my url is sef.mlxhelp.com it fails, if its www.mlxhelp.com it works.. what gives can anyone clarify why this fails? why does it even look at the prefix part? 
     
 sub transform
  {
      if (!$Session->{'isAuthenticated'}) 
      { 
      if ($Request->ServerVariables("SERVER_NAME")->item()=~/(\mlxhelp
+*)\.com/) 
         { 
         $Response->write("this is what I got $1");
          $trns=$Server->MapPath("Transforms/pLogin.xsl");
          return $trns;
          }
          if ($Request->ServerVariables("SERVER_NAME")->item()=~/(\tem
+pohelp*)\.com/) 
          { 
          $Response->write("this is what I got $1"); 
          $trns=$Server->MapPath("Transforms/tpLogin.xsl");
          return $trns;
          }
       }

    [download]
[reply]
[d/l]

      In a regular expression, "\t" is a tab character, and I'm not sure what "\m" is, if anything. 

      use Test::More 'tests' => 2;

ok( 'sef.mlxhelp.com' =~ /(\.mlxhelp)\.com/,
    q{'sef.mlxhelp.com' matches} );
ok( 'www.mlxhelp.com' =~ /(\.mlxhelp)\.com/,
    q{'www.mlxhelp.com' matches} );

      [download]

      Note that these will always put ".mlxhelp" in $1 when they match because the capturing parentheses are around that literal string.

[reply]
[d/l]
[select]
        what I am after here is capturing what url they are requesting and if it matches then supplying a login page for that particular account, since I don't want to do this 115 times, I was hoping to find a way to match it without iterating over all these possibles, I am not sure if module test:: will run on perl 5.6.1 and am very hesitant to add anything to the perl install as this is a production box. excellent point about the \t I forgot about that. I can't figure out how to get it to even echo what the url is if I type it manually can someone please tell me what I am doing wrong. there may be more than one way to do it, but I would like to find the one that works the good news is I already have discovered several that don't 
        
 sub transform
  {
      if (!$Session->{'isAuthenticated'}) 
      { 
      #Following statement checks if site is www prefix if so it check
+s tempo or mlxhelp and uses appropriate stylesheet
      #for each this only checks www. prefix need another to check the
+ rest of the potential matches
   
    
       
      if ($Request->ServerVariables("SERVER_NAME")->item()=~/(\w+)\.co
+m/) 
       {  
          $domain = $1;
         #$Response->write("This is the domain");
          if ($1 eq 'tempohelp')
          {
          my $trns= $Server->MapPath("Transforms/tpLogin.xsl");
          return $trns;
          }
          if ($1 eq 'mlxhelp')
          {
          $Response->write("This is the domain $1");
          my $trns=$Server->MapPath("Transforms/pLogin.xsl");
          return $trns;
          }
       
       }
       #closes wwww prefix check..
    if (!(substr($Request->ServerVariables("SERVER_NAME")->item(),0,3)
+ eq "www") && !(substr($Request->ServerVariables("SERVER_NAME")->item
+(),0,3) eq "mlx") && !(lc($Request->ServerVariables("SERVER_NAME")->i
+tem()) eq "localhost"))
      {
     $Request->ServerVariables("SERVER_NAME")->item() =~ /([\w]*)\./;
      $str .= ".$1.";
      $Response->write("this is $str");
     }

        [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom