Changeset 1051


Ignore:
Timestamp:
11/28/08 20:47:29 (3 years ago)
Author:
CrawfordCurrie
Message:

Item287: moved some code around to reduce the size of Foswiki.pm (over 4K lines) and make include algorithms pluggable. We really need to look at pursuing Meredith's work and breaking some of the less frequently used macros out into auto-loaded tag modules.

Location:
trunk/core/lib
Files:
4 added
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/core/lib/Foswiki.pm

    r1050 r1051  
    6666 
    6767# Other computed constants 
    68 use vars qw( 
    69   $TranslationToken 
    70   $twikiLibDir 
    71   %regex 
    72   %functionTags 
    73   %contextFreeSyntax 
    74   %restDispatch 
    75   $VERSION $RELEASE 
    76   $TRUE 
    77   $FALSE 
    78   $sandbox 
    79   $engine 
    80   $ifParser 
    81 ); 
     68our $twikiLibDir; 
     69our %regex; 
     70our %functionTags; 
     71our %contextFreeSyntax; 
     72our %restDispatch; 
     73our $VERSION; 
     74our $RELEASE; 
     75our $TRUE = 1; 
     76our $FALSE = 0; 
     77our $sandbox; 
     78our $engine; 
     79our $ifParser; 
    8280 
    8381# Token character that must not occur in any normal text - converted 
    … …  
    9189# in the string!) 
    9290# See Codev.NationalCharTokenClash for more. 
    93 $TranslationToken = "\0"; 
     91our $TranslationToken = "\0"; 
    9492 
    9593=begin TML 
    … …  
    159157    require Foswiki::Sandbox;                  # system command sandbox 
    160158    require Foswiki::Configure::Load;          # read configuration files 
    161  
    162     $TRUE  = 1; 
    163     $FALSE = 0; 
    164159 
    165160    if (DEBUG) { 
    … …  
    18491844} 
    18501845 
    1851 sub _removeNewlines { 
    1852     my ($theTag) = @_; 
    1853     $theTag =~ s/[\r\n]+/ /gs; 
    1854     return $theTag; 
    1855 } 
    1856  
    1857 # Convert relative URLs to absolute URIs 
    1858 sub _rewriteURLInInclude { 
    1859     my ( $theHost, $theAbsPath, $url ) = @_; 
    1860  
    1861     # leave out an eventual final non-directory component from the absolute path 
    1862     $theAbsPath =~ s/(.*?)[^\/]*$/$1/; 
    1863  
    1864     if ( $url =~ /^\// ) { 
    1865  
    1866         # fix absolute URL 
    1867         $url = $theHost . $url; 
    1868     } 
    1869     elsif ( $url =~ /^\./ ) { 
    1870  
    1871         # fix relative URL 
    1872         $url = $theHost . $theAbsPath . '/' . $url; 
    1873     } 
    1874     elsif ( $url =~ /^$regex{linkProtocolPattern}:/o ) { 
    1875  
    1876         # full qualified URL, do nothing 
    1877     } 
    1878     elsif ( $url =~ /^#/ ) { 
    1879  
    1880         # anchor. This needs to be left relative to the including topic 
    1881         # so do nothing 
    1882     } 
    1883     elsif ($url) { 
    1884  
    1885         # FIXME: is this test enough to detect relative URLs? 
    1886         $url = $theHost . $theAbsPath . '/' . $url; 
    1887     } 
    1888  
    1889     return $url; 
    1890 } 
    1891  
    18921846# Add a web reference to a [[...][...]] link in an included topic 
    18931847sub _fixIncludeLink { 
    … …  
    19361890} 
    19371891 
    1938 # Clean-up HTML text so that it can be shown embedded in a topic 
    1939 sub _cleanupIncludedHTML { 
    1940     my ( $text, $host, $path, $options ) = @_; 
    1941  
    1942     # FIXME: Make aware of <base> tag 
    1943  
    1944     $text =~ s/^.*?<\/head>//is 
    1945       unless ( $options->{disableremoveheaders} );    # remove all HEAD 
    1946     $text =~ s/<script.*?<\/script>//gis 
    1947       unless ( $options->{disableremovescript} );     # remove all SCRIPTs 
    1948     $text =~ s/^.*?<body[^>]*>//is 
    1949       unless ( $options->{disableremovebody} );       # remove all to <BODY> 
    1950     $text =~ s/(?:\n)<\/body>.*//is 
    1951       unless ( $options->{disableremovebody} );       # remove </BODY> 
    1952     $text =~ s/(?:\n)<\/html>.*//is 
    1953       unless ( $options->{disableremoveheaders} );    # remove </HTML> 
    1954     $text =~ s/(<[^>]*>)/_removeNewlines($1)/ges 
    1955       unless ( $options->{disablecompresstags} ) 
    1956       ;    # replace newlines in html tags with space 
    1957     $text =~ 
    1958 s/(\s(?:href|src|action)=(["']))(.*?)\2/$1._rewriteURLInInclude( $host, $path, $3 ).$2/geois 
    1959       unless ( $options->{disablerewriteurls} ); 
    1960  
    1961     return $text; 
    1962 } 
    1963  
    19641892=begin TML 
    19651893 
    … …  
    19771905    $theText = '' unless ( $theText =~ s/$thePattern/$1/is ); 
    19781906    return $theText; 
    1979 } 
    1980  
    1981 # Fetch content from a URL for inclusion by an INCLUDE 
    1982 sub _includeUrl { 
    1983     my ( $this, $url, $pattern, $web, $topic, $raw, $options, $warn ) = @_; 
    1984     my $text = ''; 
    1985  
    1986     # For speed, read file directly if URL matches an attachment directory 
    1987     if ( $url =~ 
    1988 /^$this->{urlHost}$Foswiki::cfg{PubUrlPath}\/($regex{webNameRegex})\/([^\/\.]+)\/([^\/]+)$/ 
    1989       ) 
    1990     { 
    1991         my $incWeb   = $1; 
    1992         my $incTopic = $2; 
    1993         my $incAtt   = $3; 
    1994  
    1995         # FIXME: Check for MIME type, not file suffix 
    1996         if ( $incAtt =~ m/\.(txt|html?)$/i ) { 
    1997             unless ( 
    1998                 $this->{store}->attachmentExists( $incWeb, $incTopic, $incAtt ) 
    1999               ) 
    2000             { 
    2001                 return _includeWarning( $this, $warn, 'bad_attachment', $url ); 
    2002             } 
    2003             if ( $incWeb ne $web || $incTopic ne $topic ) { 
    2004  
    2005                 # CODE_SMELL: Does not account for not yet authenticated user 
    2006                 unless ( 
    2007                     $this->security->checkAccessPermission( 
    2008                         'VIEW',    $this->{user}, undef, undef, 
    2009                         $incTopic, $incWeb 
    2010                     ) 
    2011                   ) 
    2012                 { 
    2013                     return _includeWarning( $this, $warn, 'access_denied', 
    2014                         "$incWeb.$incTopic" ); 
    2015                 } 
    2016             } 
    2017             $text = 
    2018               $this->{store} 
    2019               ->readAttachment( undef, $incWeb, $incTopic, $incAtt ); 
    2020             $text = 
    2021               _cleanupIncludedHTML( $text, $this->{urlHost}, 
    2022                 $Foswiki::cfg{PubUrlPath}, $options ) 
    2023               unless $raw; 
    2024             $text = applyPatternToIncludedText( $text, $pattern ) 
    2025               if ($pattern); 
    2026             $text = "<literal>\n" . $text . "\n</literal>" 
    2027               if ( $options->{literal} ); 
    2028             return $text; 
    2029         } 
    2030  
    2031         # fall through; try to include file over http based on MIME setting 
    2032     } 
    2033  
    2034     return _includeWarning( $this, $warn, 'urls_not_allowed' ) 
    2035       unless $Foswiki::cfg{INCLUDE}{AllowURLs}; 
    2036  
    2037     # SMELL: should use the URI module from CPAN to parse the URL 
    2038     # SMELL: but additional CPAN adds to code bloat 
    2039     unless ( $url =~ m!^https?:! ) { 
    2040         $text = _includeWarning( $this, $warn, 'bad_protocol', $url ); 
    2041         return $text; 
    2042     } 
    2043  
    2044     my $response = $this->net->getExternalResource($url); 
    2045     if ( !$response->is_error() ) { 
    2046         my $contentType = $response->header('content-type'); 
    2047         $text = $response->content(); 
    2048         if ( $contentType =~ /^text\/html/ ) { 
    2049             if ( !$raw ) { 
    2050                 $url =~ m!^([a-z]+:/*[^/]*)(/[^#?]*)!; 
    2051                 $text = _cleanupIncludedHTML( $text, $1, $2, $options ); 
    2052             } 
    2053         } 
    2054         elsif ( $contentType =~ /^text\/(plain|css)/ ) { 
    2055  
    2056             # do nothing 
    2057         } 
    2058         else { 
    2059             $text = 
    2060               _includeWarning( $this, $warn, 'bad_content', $contentType ); 
    2061         } 
    2062         $text = applyPatternToIncludedText( $text, $pattern ) if ($pattern); 
    2063         $text = "<literal>\n" . $text . "\n</literal>" 
    2064           if ( $options->{literal} ); 
    2065     } 
    2066     else { 
    2067         $text = 
    2068           _includeWarning( $this, $warn, 'geturl_failed', 
    2069             $url . ' ' . $response->message() ); 
    2070     } 
    2071  
    2072     return $text; 
    20731907} 
    20741908 
    … …  
    35203354 
    35213355    # Remove params, so they don't get expanded in the included page 
    3522     my $path    = $params->remove('_DEFAULT') || ''; 
    3523     my $pattern = $params->remove('pattern'); 
    3524     my $rev     = $params->remove('rev'); 
    3525     my $section = $params->remove('section'); 
    3526     undef $section 
    3527       if ( defined($section) && $section eq '' ) 
    3528       ;    #no sense in considering an empty string as an unfindable section 
    3529     my $raw = $params->remove('raw') || ''; 
    3530     my $warn = $params->remove('warn') 
    3531       || $this->{prefs}->getPreferencesValue('INCLUDEWARNING'); 
    3532  
    3533     if ( $path =~ /^https?:/ ) { 
    3534  
    3535         # include web page 
    3536         return $this->_includeUrl( $path, $pattern, $includingWeb, 
    3537             $includingTopic, $raw, $params, $warn ); 
    3538     } 
    3539  
    3540     if ( $path =~ s/^doc:// ) { 
    3541  
    3542         # include web page 
    3543         return $this->_includeCodeDoc( $path, $pattern, $params ); 
    3544     } 
    3545  
    3546     $path =~ s/$Foswiki::cfg{NameFilter}//go;    # zap anything suspicious 
     3356    my %control; 
     3357    for my $p qw(_DEFAULT pattern rev section raw warn) { 
     3358        $control{$p} = $params->remove($p); 
     3359    } 
     3360    # no sense in considering an empty string as an unfindable section 
     3361    delete $control{section} if ( 
     3362        defined($control{section}) && $control{section} eq '' ); 
     3363    $control{raw} ||= ''; 
     3364    $control{warn} ||= $this->{prefs}->getPreferencesValue('INCLUDEWARNING'); 
     3365    $control{inWeb} = $includingWeb; 
     3366    $control{inTopic} = $includingTopic; 
     3367    if ( $control{_DEFAULT} =~ /^([a-z]+):/ ) { 
     3368        my $handler = $1; 
     3369        eval 'use Foswiki::IncludeHandlers::'.$handler; 
     3370        die $@ if ($@); 
     3371        unless ($@) { 
     3372            $handler = 'Foswiki::IncludeHandlers::'.$handler; 
     3373            return $handler->INCLUDE($this, \%control, $params); 
     3374        } 
     3375    } 
     3376 
     3377    # No protocol handler; must be a topic references 
     3378    $control{_DEFAULT} =~ s/$Foswiki::cfg{NameFilter}//go;    # zap anything suspicious 
    35473379    if ( $Foswiki::cfg{DenyDotDotInclude} ) { 
    35483380 
    35493381        # Filter out '..' from filename, this is to 
    35503382        # prevent includes of '../../file' 
    3551         $path =~ s/\.+/\./g; 
     3383        $control{_DEFAULT} =~ s/\.+/\./g; 
    35523384    } 
    35533385    else { 
    35543386 
    35553387        # danger, could include .htpasswd with relative path 
    3556         $path =~ s/passwd//gi;                 # filter out passwd filename 
     3388        $control{_DEFAULT} =~ s/passwd//gi;                 # filter out passwd filename 
    35573389    } 
    35583390 
    35593391    # make sure we have something to include. If we don't do this, then 
    35603392    # normalizeWebTopicName will default to WebHome. Item2209. 
    3561     unless ($path) { 
     3393    unless ($control{_DEFAULT}) { 
    35623394 
    35633395        # SMELL: could do with a different message here, but don't want to 
    35643396        # add one right now because translators are already working 
    3565         return _includeWarning( $this, $warn, 'topic_not_found', '""', '""' ); 
     3397        return _includeWarning( $this, $control{warn}, 'topic_not_found', '""', '""' ); 
    35663398    } 
    35673399 
    … …  
    35693401    my $meta = ''; 
    35703402    my $includedWeb; 
    3571     my $includedTopic = $path; 
     3403    my $includedTopic = $control{_DEFAULT}; 
    35723404    $includedTopic =~ s/\.txt$//;    # strip optional (undocumented) .txt 
    35733405 
    … …  
    35773409    # See Codev.FailedIncludeWarning for the history. 
    35783410    unless ( $this->{store}->topicExists( $includedWeb, $includedTopic ) ) { 
    3579         return _includeWarning( $this, $warn, 'topic_not_found', $includedWeb, 
     3411        return _includeWarning( $this, $control{warn}, 'topic_not_found', $includedWeb, 
    35803412            $includedTopic ); 
    35813413    } 
    … …  
    35883420    $key .= $args; 
    35893421    if ( $this->{_INCLUDES}->{$key} || $count > 99 ) { 
    3590         return _includeWarning( $this, $warn, 'already_included', 
     3422        return _includeWarning( $this, $control{warn}, 'already_included', 
    35913423            "$includedWeb.$includedTopic", '' ); 
    35923424    } 
    … …  
    36053437 
    36063438    ( $meta, $text ) = 
    3607       $this->{store}->readTopic( undef, $includedWeb, $includedTopic, $rev ); 
     3439      $this->{store}->readTopic( undef, $includedWeb, $includedTopic, $control{rev} ); 
    36083440 
    36093441    # Simplify leading, and remove trailing, newlines. If we don't remove 
    … …  
    36193451      ) 
    36203452    { 
    3621         if ( isTrue($warn) ) { 
     3453        if ( isTrue($control{warn}) ) { 
    36223454            return $this->inlineAlert( 'alerts', 'access_denied', 
    36233455                "[[$includedWeb.$includedTopic]]" ); 
    … …  
    36283460    # remove everything before and after the default include block unless 
    36293461    # a section is explicitly defined 
    3630     if ( !$section ) { 
     3462    if ( !$control{section} ) { 
    36313463        $text =~ s/.*?%STARTINCLUDE%//s; 
    36323464        $text =~ s/%STOPINCLUDE%.*//s; 
    … …  
    36363468    my ( $ntext, $sections ) = parseSections($text); 
    36373469 
    3638     my $interesting = ( defined $section ); 
     3470    my $interesting = ( defined $control{section} ); 
    36393471    if ( $interesting || scalar(@$sections) ) { 
    36403472 
    … …  
    36423474        $text = ''; 
    36433475        foreach my $s (@$sections) { 
    3644             if (   $section 
     3476            if (   $control{section} 
    36453477                && $s->{type} eq 'section' 
    3646                 && $s->{name} eq $section ) 
     3478                && $s->{name} eq $control{section} ) 
    36473479            { 
    36483480                $text .= substr( $ntext, $s->{start}, $s->{end} - $s->{start} ); 
    … …  
    36503482                last; 
    36513483            } 
    3652             elsif ( $s->{type} eq 'include' && !$section ) { 
     3484            elsif ( $s->{type} eq 'include' && !$control{section} ) { 
    36533485                $text .= substr( $ntext, $s->{start}, $s->{end} - $s->{start} ); 
    36543486                $interesting = 1; 
    … …  
    36603492    $text = $ntext unless $interesting; 
    36613493 
    3662     $text = applyPatternToIncludedText( $text, $pattern ) if ($pattern); 
     3494    $text = applyPatternToIncludedText( $text, $control{pattern} ) if ($control{pattern}); 
    36633495 
    36643496    # Do not show TOC in included topic if TOC_HIDE_IF_INCLUDED 
    … …  
    44894321 
    44904322    return '| *Group* | *Members* |' . "\n" . join( "\n", sort @table ); 
    4491 } 
    4492  
    4493 # Include embedded doc in a core module 
    4494 sub _includeCodeDoc { 
    4495     my ( $this, $class, $pattern, $params ) = @_; 
    4496  
    4497     return '' unless $class && $class =~ /^Foswiki/; 
    4498     $class =~ s/[^\w:]//g; 
    4499  
    4500     my $pmfile; 
    4501     $class =~ s#::#/#g; 
    4502     foreach my $inc (@INC) { 
    4503         if ( -f "$inc/$class.pm" ) { 
    4504             $pmfile = "$inc/$class.pm"; 
    4505             last; 
    4506         } 
    4507     } 
    4508     return '' unless $pmfile; 
    4509  
    4510     open( PMFILE, '<', $pmfile ) || return ''; 
    4511     my $inPod = 0; 
    4512     my $pod = ''; 
    4513     local $/ = "\n"; 
    4514     while ( my $line = <PMFILE> ) { 
    4515         if ( $line =~ /^=(begin (twiki|TML|html)|pod)/ ) { 
    4516             $inPod = 1; 
    4517         } 
    4518         elsif ( $line =~ /^=cut/ ) { 
    4519             $inPod = 0; 
    4520         } 
    4521         elsif ($inPod) { 
    4522             $pod .= $line; 
    4523         } 
    4524     } 
    4525     close(PMFILE); 
    4526  
    4527     $pod =~ s/.*?%STARTINCLUDE%//s; 
    4528     $pod =~ s/%STOPINCLUDE%.*//s; 
    4529  
    4530     $pod = applyPatternToIncludedText( $pod, $pattern ) if ($pattern); 
    4531  
    4532     # Adjust the root heading level 
    4533     if ( $params->{level} ) { 
    4534         my $minhead = '+' x 100; 
    4535         $pod =~ s/^---(\++)/ 
    4536           $minhead = $1 if length($1) < length($minhead); "---$1"/gem; 
    4537         return $pod if length($minhead) == 100; 
    4538         my $newroot = '+' x $params->{level}; 
    4539         $minhead =~ s/\+/\\+/g; 
    4540         $pod =~ s/^---$minhead/---$newroot/gm; 
    4541     } 
    4542     return $pod; 
    45434323} 
    45444324 
Note: See TracChangeset for help on using the changeset viewer.