var fi,fo:text;
    sir:string;
    cuv:array[0..50000]of string[21];
    solutii:array[1..10000000]of string[21];
    cont,i,ct1,ct,ct2,ct3,rez,rez1:longint;
procedure heapsort1(n:longint);
var i,j,k:longint;
    aux:string[21];
begin
   for i:=1 to n do
    begin
     j:=i;
     while (j div 2<>0) and (solutii[j div 2]<solutii[j]) do
      begin
        aux:=solutii[j div 2];
        solutii[j div 2]:=solutii[j];
        solutii[j]:=aux;
        j:=j div 2;
      end;
    end;
   i:=n;
   while i>1 do
    begin
     aux:=solutii[1];
     solutii[1]:=solutii[i];
     solutii[i]:=aux;
     dec(i);
     j:=1;
     while (j>0) do
      begin
       k:=2*j;
       if (k>i) then  break;
       if (k+1<=i) and (solutii[k+1]>solutii[k]) then inc(k);
       if solutii[j]>=solutii[k] then break;

       aux:=solutii[j];
       solutii[j]:=solutii[k];
       solutii[k]:=aux;
       j:=k;
      end;
     end;
end;
procedure heapsort2(n:longint);
var i,j,k:longint;
    aux:string[21];
begin
   for i:=1 to n do
    begin
     j:=i;
     while (j div 2<>0) and (cuv[j div 2]<cuv[j]) do
      begin
        aux:=cuv[j div 2];
        cuv[j div 2]:=cuv[j];
        cuv[j]:=aux;
        j:=j div 2;
      end;
    end;
   i:=n;
   while i>1 do
    begin
     aux:=cuv[1];
     cuv[1]:=cuv[i];
     cuv[i]:=aux;
     dec(i);
     j:=1;
     while (j>0) do
      begin
       k:=2*j;
       if (k>i) then  break;
       if (k+1<=i) and (cuv[k+1]>cuv[k]) then inc(k);
       if cuv[j]>=cuv[k] then break;

       aux:=cuv[j];
       cuv[j]:=cuv[k];
       cuv[k]:=aux;
       j:=k;
      end;
     end;
end;
function findmax(x:longint; aux:string[21]):longint;
var st,dr,mij:longint;
begin
     st:=1; dr:=x;  findmax:=0;
     while st<=dr do
        begin
             mij:=(st+dr) shr 1;
             if (solutii[mij]=aux) then
                begin
                     findmax:=mij;
                     st:=mij+1;
                     if solutii[mij+1]>aux then exit;
                end
             else
                if solutii[mij]>aux then dr:=mij-1
                                    else st:=mij+1;
        end;
end;
function findmin(x:longint; aux:string[21]):longint;
var st,dr,mij:longint;
begin
     st:=1; dr:=x; findmin:=0;
     while st<=dr do
        begin
             mij:=(st+dr) shr 1;
             if (solutii[mij]=aux) then
                begin
                     findmin:=mij;
                     dr:=mij-1;
                     if solutii[mij-1]<aux then exit;
                end
             else
                if solutii[mij]>aux then dr:=mij-1
                                    else st:=st+1;
        end;
end;
begin
     assign(fi,'abc2.in'); reset(fi);
     assign(fo,'abc2.out'); rewrite(fo);
     readln(fi,sir);
     while not eof(fi) do
        begin
             inc(ct);
             readln(fi,cuv[ct]);
        end;
     ct1:=0; ct2:=length(cuv[1]); ct3:=length(sir); cont:=0;
     while ct1<ct3-3 do
        begin
             inc(ct1);
             solutii[ct1]:=copy(sir,1,ct2);
             delete(sir,1,1);
        end;
     heapsort1(ct1);
     heapsort2(ct);
     cuv[0]:='';
     for i:=1 to ct do
       if cuv[i]<>cuv[i-1] then
        begin
             rez1:=findmax(ct1,cuv[i]);
             if rez1<>0 then
                begin
                     rez:=rez1-findmin(ct1,cuv[i])+1;
                     cont:=cont+rez;
                end;
        end;
     writeln(fo,cont);
     close(fi);
     close(fo);
end.