package iTextparser;
use strict;

BEGIN {
    require 'Lib/FUNC.pm';
}

$iTextparser::ERROR = undef;

my $std   = FUNC::STD->new();
#+------------------------------------------------------------------------------------------------------

sub new {
  my $pkg = shift;
  my $obj = { IMG_CNT => '0', ERROR => undef };
  bless $obj, $pkg;
  return $obj;
}

#+------------------------------------------------------------------------------------------------------

# BENDER: "No room for Bender eh? I'm gonna build my own lundar landing with hookers and blackjack....
#         "actually, forget the hookers... and the blackjack.. oh, screw the whole thing."


sub do_wrapper {
    my $in = shift;

    $in->{TYPE} ||= 'id';
    $in->{CSS}  ||= 'postcolor';


    # This little sub generates the SQL, CODE, QUOTE and HTML wrappers
    # this makes the code a little cleaner, and enables us to change the HTML
    # fairly easily

    # In has three buckets to it's hash ref.

    #STYLE => Which CSS style do we want to use for the final td id (QUOTE or CODE)?
    #TYPE  => Because we have to close the original span down (to make sure that the table
    #         isn't wrapped in an odd span, we'll need to know which type of CSS we are using,
    #         id or class
    #CSS   => The CSS to default back to after we've closed the table.
    #EXTRA => any other text to appear next to the "Quote" bolded word

    #Possible uses          # CSS    #Text

    my %use = ( CODE  => [ 'CODE' , $Universal::lang->{code_sample} ],
                QUOTE => [ 'QUOTE', $Universal::lang->{quote_text}  ],
                SQL   => [ 'CODE' , 'SQL'                           ],
                HTML  => [ 'CODE' , 'HTML'                          ],
              );

    # Create two returnable keys, START and END

    my %html = ();

    $html{START} = qq~</span><table border="0" align="center" width="95%" cellpadding="3" cellspacing="1"><tr><td><b>$use{ $in->{STYLE} }[1]</b> $in->{EXTRA}</td></tr><tr><td id="$use{ $in->{STYLE} }[0]">~;
    $html{END}   = qq~</td></tr></table><span $in->{TYPE}='$in->{CSS}'>~;

    #Return it...
    return \%html;
}


sub Convert_for_db {
    my $obj = shift;
    my $IN  = { TEXT  => "", SMILIES => "", IB_CODE => "", HTML => "", SIG => "", USER => "", @_, };

    my $Txt = $IN->{'TEXT'};

    return unless $Txt;

    if ($IN->{'IB_CODE'}) {

        goto SMILIES unless ($Txt =~ m#[\[\]\(\:]#);

        while ($Txt =~ s{\[code\]([\S\s].+?[\S\s])\[/code\]}
                       {my $Tmp = $1;
                        $Tmp =~ s!&lt;!&#60;!g;
                        $Tmp =~ s!&gt;!&#62;!g;
                        $Tmp =~ s!&quot;!&#34;!g;
                        $Tmp =~ s!\s{1};!&#59;!g;
                        $Tmp =~ s!:!&#58;!g;
                        $Tmp =~ s!\[!&#91;!g;
                        $Tmp =~ s!\]!&#93;!g;
                        $Tmp =~ s!\)!&#41;!g;
                        $Tmp =~ s!\(!&#40;!g;
                        my $html = do_wrapper({STYLE=>'CODE',TYPE=>"id",CSS=>"postcolor"});
                        $Tmp = qq|<!--c1-->$html->{START}<!--ec1-->$Tmp<!--c2-->$html->{END}<!--ec2-->|;
                       }exisog) {}

        my ($html, $det, $auth, $time, $extra,$Begin, $End);

        $Txt =~ s{\[quote\](.+?)\[\/quote\]}   {
                   $html = do_wrapper({STYLE=>'QUOTE'});
                   qq[<!--QuoteBegin-->$html->{START}<\!--QuoteEBegin-->$1<\!--QuoteEnd-->$html->{END}<\!--QuoteEEnd-->];
                 }eisgx;

        $Txt =~ s{\[quote=(.+?),\s*(.+?)\](.+?)\[\/quote\]}   {
                    $auth = $1;
                    $time = $2;
                    $html = do_wrapper({STYLE=>'QUOTE', EXTRA => "($auth \@ $time)"});
                    $extra = "-\-$auth\+$time";
                   qq[<!--QuoteBegin$extra-->$html->{START}<\!--QuoteEBegin-->$3<\!--QuoteEnd-->$html->{END}<\!--QuoteEEnd-->];
                 }eisgx;

        unless ($IN->{SIG}) {

            #SQL syntax highlighting.
            while ($Txt =~ s{\[sql\](.+?)\[\/sql\]}
                {    my $sql = $1;
                     $sql =~ s!^<br>!!;
                     $sql =~ s:^\s+::;
                     $sql =  $sql.' ' unless $sql =~ m:\s+$:;
                     # Work backwards.
                     $sql =~ s!(\S+)\s{0,}(=|\+|\-|&gt;|&lt;|~|==|\!=|LIKE|NOT LIKE|REGEXP)!<span style='color:#333333'>$1</span> <span style='color:orange'>$2</span> !ig;
                     $sql =~ s!(&quot;|&#39;|&#039;)(.+?)(&quot;|&#39;|&#039;)!<span style='color:red'>$1$2$3</span>!ig;
                     $sql =~ s!\s{1,}(AND|OR)\s{1,}!qq~ <span style='color:blue'>~.uc($1).qq~</span> ~;!eig;
                     $sql =~ s!(WHERE|MODIFY|CHANGE|AS|DISTINCT|IN|ASC|DESC|ORDER BY)\s{1,}!qq~<span style='color:green'>~.uc($1).qq~</span> ~;!eig;
                     $sql =~ s!LIMIT\s*(\d+)\s*,\s*(\d+)!<span style='color:green'>LIMIT</span> <span style='color:orange'>$1, $2</span> !i;
                     $sql =~ s!(FROM|INTO)\s{1,}(\S+?)\s{1,}!<span style='color:green'>$1</span> <span style='color:orange'>$2</span> !i;
                     $sql =~ s!(SELECT|INSERT|UPDATE|DELETE|ALTER TABLE|DROP)!qq~<span style="color:blue;font-weight:bold">~.uc($1).qq~</span>~;!ei;
                     my $html = do_wrapper({STYLE=>'SQL'});
                     qq#<!--sql-->$html->{START}<!--sql1-->$sql<!--sql2-->$html->{END}<!--sql3-->#;
                }eisgx) {}
    
            #HTML syntax highlighting
            while ($Txt =~ s{\[html\](.+?)\[\/html\]}
                {    my $html = $1;
                     $html =~ s#&lt;(\w+)(.??)(?=&)&gt;#&lt;<span style='color:blue'>$1</span>$2&gt;#ig;
                     $html =~ s#&lt;/(\w+)(.??)(?=&)&gt;#&lt;/<span style='color:blue'>$1</span>$2&gt;#ig;
                     $html =~ s#&lt;(\w+)(.+?)(?=&)&gt;#&lt;<span style='color:blue'>$1</span>$2&gt;#ig;
                     $html =~ s!=(&quot;|&#39;)(.+?)(&quot;|&#39;)(\s|&gt;)!=$1<span style='color:orange'>$2</span>$3$4!ig;
                     $html =~ s!&#60;&#33;--(.+?)--&#62;!&lt;&#33;<span style='color:red'>--$1--</span>&gt;!ig;
                     my $wrap = do_wrapper({STYLE=>'HTML'});
                     qq#<!--html-->$wrap->{START}<!--html1--><span style='color:\#333333'>$html</span><!--html2-->$wrap->{END}<!--html3-->#;
                }eisgx) {}
                
        }

        $Txt =~ s!<br>!\n!isg;

        if ($iB::INFO->{'ALLOW_IMAGES'}) {
            my $url;
            if ($Txt =~ s!\[img\](.+?)\[/img\]!$url = $1; "<img src=\"$1\" border=\"0\">"!gei) {

                ++$obj->{'IMG_CNT'};
                if ($iB::INFO->{'MAX_IMAGES'}) {
                    $obj->{'ERROR'} = 'too_many_img' if $obj->{'IMG_CNT'} > $iB::INFO->{'MAX_IMAGES'};
                }

                unless ($iB::INFO->{'ALLOW_DYNAMIC_IMG'}) {
                    $obj->{'ERROR'} = 'no_dynamic' if $url =~ m#[?&;]#;
                    $obj->{'ERROR'} = 'no_dynamic' if $url =~ /javascript(\:|\s)/i;
                }

                if ($iB::INFO->{'IMG_EXT'}) {
                    # We use the "greedy" match .* to match everything up until the furthermost right
                    # period. We hope that this will be the image extension.
                    $url =~ m!^.*\.(\S+)$!ig;
                    my $ext = $1;
                    unless ( grep { lc($ext) eq lc($_) } (split/\|/, $iB::INFO->{'IMG_EXT'}) ) {
                        $obj->{'ERROR'} = 'invalid_ext';
                    }
                }
            }

            if (($Txt=~ m!(\[FLASH=)(\S+?)(\,)(\S+?)(\])(\S+?)(\[\/FLASH\])!i) and ($iB::INFO->{'ALLOW_FLASH'})) {
                my $width  = $2;
                my $height = $4;
                my $url    = $6;
                $obj->{'ERROR'} = 'flash_too_big' unless $width  and $width  <= $iB::INFO->{'MAX_W_FLASH'};
                $obj->{'ERROR'} = 'flash_too_big' unless $height and $height <= $iB::INFO->{'MAX_H_FLASH'};
                $obj->{'ERROR'} = 'flash_number'  unless $width  =~ /\A[0-9]+\Z/;
                $obj->{'ERROR'} = 'flash_number'  unless $height =~ /\A[0-9]+\Z/;
                $obj->{'ERROR'} = 'flash_url'     unless $url and $url    =~ m#\Ahttp\://(\S+?)\.swf#i;
                $Txt =~ s!(\[FLASH=)(\S+?)(\,)(\S+?)(\])(\S+?)(\[\/FLASH\])!<\!--Flash $2+$4+$6--><OBJECT CLASSID="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000" WIDTH=$2 HEIGHT=$4><PARAM NAME=MOVIE VALUE=$6><PARAM NAME=PLAY VALUE=TRUE><PARAM NAME=LOOP VALUE=TRUE><PARAM NAME=QUALITY VALUE=HIGH><EMBED SRC=$6 WIDTH=$2 HEIGHT=$4 PLAY=TRUE LOOP=TRUE QUALITY=HIGH></EMBED></OBJECT><\!--End Flash-->!isg;
            }
        }


        $Txt =~ s!(^|\s)(http://\S+)!$1."<a href=\"".$obj->fix_real_url($2)."\" target=\"_blank\">".$obj->chomp_url($2)."</a>"!eig;
        $Txt =~ s!(^|\s)(https://\S+)!$1."<a href=\"".$obj->fix_real_url($2)."\" target=\"_blank\">".$obj->chomp_url($2)."</a>"!eig;
        $Txt =~ s!(^|\s)(ftp://\S+)!$1."<a href=\"".$obj->fix_real_url($12)."\" target=\"_blank\">".$obj->chomp_url($2)."</a>"!eig;
        $Txt =~ s!(^|\s)([\.\w\-]+\@[\.\w\-]+\.[\.\w\-]+)!$1<a href=\"mailto:$2\">$2</a>!isg;


        $Txt =~ s!\[email\](\S+?)\[/email\]!<a href="mailto:$1">$1</a>!ig;
        $Txt =~ s!\[url\](\S+?)\[/url\]!"<a href=\"".$obj->fix_real_url($1)."\" target='_blank'>".$obj->chomp_url($1)."</a>"!eig;
        $Txt =~ s!\[url\s*=\s*\&quot\;\s*(\S+?)\s*\&quot\;\s*\](.*?)\[\/url\]!"<a href=\"".$obj->fix_real_url($1)."\" target=\"_blank\">".$obj->chomp_url($2)."</a>"!eisg;
        $Txt =~ s!\[url\s*=\s*(\S+?)\s*\](.*?)\[\/url\]!"<a href=\"".$obj->fix_real_url($1)."\" target=\"_blank\">".$obj->chomp_url($2)."</a>"!eisg;
        $Txt =~ s!\[email\s*=\s*\&quot\;([\.\w\-]+\@[\.\w\-]+\.[\.\w\-]+)\s*\&quot\;\s*\](.*?)\[\/email\]!<a href=\"mailto:$1\">$2</a>!isg;
        $Txt =~ s!\[email\s*=\s*([\.\w\-]+\@[\.\w\-]+\.[\w\-]+)\s*\](.*?)\[\/email\]!<a href=\"mailto:$1\">$2</a>!isg;

        #Remove Session ID's from posted links:

        $Txt =~ s!(?:(\?)|&amp;|[&;])s=[\w\d]{16,32}(?:&amp;|&|;|$)!$1!g;

        $Txt =~ s/\(c\)/&copy;/ig;
        $Txt =~ s/\(r\)/&reg;/ig;
        $Txt =~ s/\(tm\)/&#153;/ig;

        $Txt =~ s!(\[i\])(.+?)(\[/i\])!<i>$2</i>!isg;
        $Txt =~ s!(\[s\])(.+?)(\[/s\])!<s>$2</s>!isg;
        $Txt =~ s!(\[u\])(.+?)(\[/u\])!<u>$2</u>!isg;
        $Txt =~ s!(\[b\])(.+?)(\[/b\])!<b>$2</b>!isg;
        $Txt =~ s!\[size=\s*(.*?)\s*\]\s*(.*?)\s*\[\/size\]!my $size = $1+7; "<span style='font-size:".$size."pt;line-height:100%'>$2</span>"!eisg;
        $Txt =~ s!\[font=\s*(.*?)\s*\]\s*(.*?)\s*\[\/font\]!<span style='font-family:$1'>$2</span>!isg;
        $Txt =~ s!\[color=\s*(.*?)\s*\]\s*(.*?)\s*\[\/color\]!<span style='color:$1'>$2</span>!isg;


        unless ($IN->{SIG}) {
            # Disallow these tags in signatures
            $Txt =~ s!\[br\]!<br>!ig;
            $Txt =~ s!\[list\]!<ul>!isg;
            $Txt =~ s!\[\*\]!<li>!isg;
            $Txt =~ s!\[\/list\]!</ul>!isg;
            my $name = $IN->{USER} || $iB::MEMBER->{'MEMBER_NAME'} || $iB::IN{'UserName'} || 'iB User';
            $Txt =~ s!(\[me\])(.+?)(\[/me\])!<\!--me&$name--><span id='ME'><center>$name $2</center></span><\!--e-me-->!isg;
            $Txt =~ s!\[me\s*=\s*(.+?)\](.*?)\[/me\]!<\!--me&$name--><span id='ME'><center>$1 $2</center></span><\!--e-me-->!isg;
        }

    }

SMILIES:

    $Txt =~ s!\n!<br>!isg;

    $obj->{EMO_COUNT} = 0;

    if ($IN->{'SMILIES'}) {
        # We need to sort by length, otherwise :poke: may be confused with :p
        # First, lets build us a key of associative arrays..
    
        my %smilies = map  {      $_->[0] => [ $_->[1],  $_->[2] ]       }                                                  # Map an annon aray w/ha
                      map  {            [ split (/\|/) ]                 }   ( split (/\|&\|/,$iB::INFO->{'EMOTICONS'}) );  # Feed and split the string

        for my $type ( sort { length($b) <=> length($a) } keys %smilies ) {
            my $image = $smilies{ $type }[0];
            my $p_inc = $smilies{ $type }[1];
            next unless $type and $image;

            $type =~ s/&/&amp;/g;
            $type =~ s/</&lt;/g;
            $type =~ s/>/&gt;/g;
            $type =~ s/"/&quot;/g;
            $type =~ s/'/&#039;/g;
            $type =~ s/&#124;/\|/g;

            my $old_emoticon = $type;
            $type = quotemeta ($type);

            # We can't use \b as non English perl installations won't
            #Ęparse the regex properly.
            if ($Txt =~ s{(^|\G|[^A-Za-z\.,:\$&'"\)\(])$type([^A-Za-z\-']|$)}
                {
                    my $ender   = $2;
                    my $starter = $1;
                    ++$obj->{'EMO_COUNT'};
                    qq~$starter<\!--emo&$old_emoticon--><img src="$iB::INFO->{'EMOTICONS_URL'}/$image" border="0" valign="absmiddle" alt='$old_emoticon'><\!--endemo-->$ender~;

                }eigsx) {}
        }

        if ($iB::INFO->{'MAX_EMOS'}) {
            if ($obj->{'EMO_COUNT'} > $iB::INFO->{'MAX_EMOS'}) {
                $obj->{'ERROR'} = 'too_many_emoticons';
            }
        }
    }

    if ($IN->{'HTML'}) {
        $Txt =~ s!&gt;!>!g;
        $Txt =~ s!&lt;!<!g;
        $Txt =~ s!&amp;!&!g;
        $Txt =~ s!&quot;!"!g;
        # Lets take a stab at limiting iEvil damage..
        $Txt =~ s!(?:onload=|<javascript|onmouseover=|onmouseout=|applet=|<iframe|<frame|onblur=|onfocus=|<head|<body|<meta\s*name=)!!ig;
    }


    if ($iB::INFO->{'WORD_FILTER'}) {
        my @words = split /\|/, $iB::INFO->{'WORD_FILTER'};

        for (@words) {
            my ($original, $method, $replacement) = split /\:/, $_;
            $replacement = "#" x length($original) unless $replacement;
            
            if ($method eq 'e') {
                $Txt =~ s!(\A|\b)$original(\b|\Z|\!|\?|\.)!$replacement!ig;
            } else {
                $Txt =~ s!\Q$original\E!$replacement!ig;
            }
        }
    }

    $Txt =~ s!([\-\_\;\'\"\,\.\!\@\Ł\^\&\*\(\)\d\w\?\+\}\{\]\[\`\~]{90})(?=\S)!$1<br>!g;
    return $Txt;    
}


#+------------------------------------------------------------------------------------------------------
#+------------------------------------------------------------------------------------------------------

sub Convert_for_textfield {
    my ($obj, $Txt) = @_;

    $Txt =~ s{<!--Flash (.+?)-->.+?<!--End Flash-->} { my $tmp = $1; my($w,$h,$u) = split (/\+/,$tmp); qq!\[FLASH=$w\,$h\]$u\[/FLASH\]!; }isge;
    $Txt =~ s!(<img src=["'])(\S+)(["'].+?>)!\[img\]$2\[/img\]!isg;
    $Txt =~ s!(<a href=["'])(http|https|ftp|news)://(\S+?)["'].+?>(.+?)</a>!\[URL=$2://$3\]$4\[/URL\]!isg;
    $Txt =~ s!(<a href=["']mailto:)(.+?)(['"]>)(.+?)(</a>)!\[EMAIL=$2\]$4\[/EMAIL\]!isg;
    $Txt =~ s!(<i>)(.+?)(</i>)!\[i\]$2\[/i\]!isg;
    $Txt =~ s!(<u>)(.+?)(</u>)!\[u\]$2\[/u\]!isg;
    $Txt =~ s!(<b>)(.+?)(</b>)!\[b\]$2\[/b\]!isg;
    $Txt =~ s!(<s>)(.+?)(</s>)!\[s\]$2\[/s\]!isg;
    $Txt =~ s!<ul>!\[list\]!isg;
    $Txt =~ s!<li>!\[\*\]!isg;
    $Txt =~ s!</ul>!\[/list\]!isg;
    while ($Txt =~ s{<!--sql-->(.+?)<!--sql1-->(.+?)<!--sql2-->(.+?)<!--sql3-->}
        {   my $sql = $2;
            $sql =~ s!<span style=["'](.+?)['"]>!!g;
            $sql =~ s!</span>!!g;
            $sql =~ s!\s*$!!;
            qq#\[sql\]$sql\[/sql\]#;
        }eisgx) {}
    while ($Txt =~ s{<!--html-->(.+?)<!--html1-->(.+?)<!--html2-->(.+?)<!--html3-->}
        {   my $html = $2;
            $html =~ s!<span style=["'](.+?)['"]>!!g;
            $html =~ s!</span>!!g;
            qq#\[html\]$html\[/html\]#;
        }eisgx) {}

    while ($Txt =~ s{<!--me&(.+?)-->(.+?)<!--e-me-->}
        {   my $name = $1;
            my $text = $2;
            $text =~ s!<span id='ME'><center>(.+?)</center></span>!$1!;
            $text =~ s!$name!!;
            qq#\[me=$name\]$text\[/me\]#;
        }eisgx) { }

    $Txt =~ s!<\!--sql-->(.+?)<\!--sql31-->!\[sql\]!isg;
    $Txt =~ s!<span style=['"]font-size\:(.+?)pt;line-height:100%['"]>(.+?)</span>!my $size=$1; $size-=7;"\[size=$size\]$2\[/size\]"!eisg;
    $Txt =~ s!<span style=['"]color\:(.+?)['"]>(.+?)</span>!\[color=$1\]$2\[/color\]!isg;
    $Txt =~ s!<span style=['"]font-family\:(.+?)['"]>(.+?)</span>!\[font=$1\]$2\[/font\]!isg;
    $Txt =~ s!<\!--c1-->(.+?)<\!--ec1-->!\[code\]!isg;
    $Txt =~ s!<\!--c2-->(.+?)<\!--ec2-->!\[/code\]!isg;

    $Txt =~ s!<\!--QuoteBegin-->(.+?)<\!--QuoteEBegin-->!\[quote\]!isg;
    $Txt =~ s!<\!--QuoteBegin--(.+?)\+(.+?)-->(.+?)<\!--QuoteEBegin-->!\[quote=$1,$2\]!isg;
    $Txt =~ s!<\!--QuoteEnd-->(.+?)<\!--QuoteEEnd-->!\[/quote\]!isg;
    $Txt =~ s#<!--EDIT\|(.+?)\|(.+?)-->##ig;
    $Txt =~ s!<\!--emo&(.+?)-->.+?<\!--endemo-->!$1!ig;
    $Txt =~ s!<br>!\n!ig;
    $Txt =~ s!<!&lt;!g;
    $Txt =~ s!>!&gt;!g;
    $Txt =~ s!"!&quot;!g;
    return $Txt;
}

#+------------------------------------------------------------------------------------------------------
#+------------------------------------------------------------------------------------------------------

sub Convert_for_email ($$) {
    my ($obj, $Txt) = @_;
    $Txt =~ s!<br>!\n!ig;
    $Txt =~ s!(<i>)(.+?)(</i>)!\_$2\_!isg;
    $Txt =~ s!(<b>)(.+?)(</b>)!\*$2\*!isg;
    $Txt =~ s{<!--Flash (.+?)-->.+?<!--End Flash-->} { my $tmp = $1; my($w,$h,$u) = split (/\+/,$tmp); qq!(FLASH MOVIE: (Width: $w) (Height: $h) URL: $u)!; }isge;
    $Txt =~ s!(<a href=["'])(http|https|ftp|news)://(\S+?)["'].+?>(.+?)</a>!(URL: $2://$3)!isg;
    $Txt =~ s!(<a href="mailto:)(.+?)(" class='postcolor'>)(.+?)(</a>)!(EMAIL: $2)!isg;
    $Txt =~ s!<\!--c1-->(.+?)<\!--ec1-->!\n\n---------------------CODE SAMPLE-------------------\n!isg;
    $Txt =~ s!<\!--c2-->(.+?)<\!--ec2-->!\n---------------------CODE SAMPLE-------------------\n\n!isg;
    $Txt =~ s!<\!--QuoteBegin-->(.+?)<\!--QuoteEBegin-->!\n\n---------------------QUOTE-------------------\n!isg;
    $Txt =~ s!<\!--QuoteEnd-->(.+?)<\!--QuoteEEnd-->!\n---------------------QUOTE-------------------\n\n!isg;
    $Txt =~ s!<\!--emo&(.+?)-->.+?<\!--endemo-->!$1!ig;
    $Txt =~ s!(<img src=["'])(\S+)(["']>)!(IMAGE: $2)!isg;
    $Txt =~ s!<(.+?)>!!sg;
    $Txt =~ s|&#33;|!|g;
    $Txt =~ s!&amp;!&!g;
    $Txt =~ s!&.+?;!!g;
    return $Txt;
}


sub fix_real_url {
    my ($obj, $url) = @_;
    # Fix up the ampersands
    $url =~ s!&amp;!&!g;
    return $url;
}


sub chomp_url ($$) {
    my ($obj, $the_red_sea) = @_;
    return $the_red_sea   if    $the_red_sea =~ /^<img src=/;
    return $the_red_sea unless length($the_red_sea) > 70;
    return $the_red_sea unless $the_red_sea =~ m!://!;
    # Fix up 'dem pesky ampersands
    $the_red_sea =~ s!&amp;!&!g;
    $the_red_sea =~ s!(?:(\?)|[&;])s=[\w\d]{16,32}(?:&|;|$)!$1!g;
    my ($moses, $did_indeed) = split /\:\/\//, $the_red_sea;
    my @miracle = split "/",$did_indeed;
    my $worker = substr($miracle[1], 0, 7,);
    my $maybe  = substr($miracle[$#miracle],length($miracle[$#miracle])-7);
    return $moses.'://'.$miracle[0].'/'.$worker.'....'.$maybe;
}

1;