nearlinks.pl

   1
   2 *OldBrowseResolvedPage = *BrowseResolvedPage;
   3 *BrowseResolvedPage = *NewBrowseResolvedPage;
   4
   5 sub NewBrowseResolvedPage {
   6   my $id = shift;
   7   my ($class, $new, $title) = ResolveId($id);
   8   if ($class eq 'near' && not GetParam('rcclusteronly', 0)) {
   9     print $q->redirect({-uri=>$NearSite{$title} . $new});
  10   } else {
  11     OldBrowseResolvedPage($id);
  12   }
  13 }
  14
  15 *OldResolveId = *ResolveId;
  16 *ResolveId = *NewResolveId;
  17
  18 my %NearPage = ();
  19 my %NearSite = ();
  20 my %NearLinksUsed = ();
  21
  22 sub NearInit {
  23   if (not %NearPage) {
  24     GetSiteUrl(); # make sure %InterSite is set
  25     local $/ = undef;
  26     foreach my $site (keys %InterSite) {
  27       open(F, $DataDir . '/' . $site) or next;
  28       my $data = <F>;
  29       close(F);
  30       foreach (split(/\n/, $data)) {
  31         if (not $NearPage{$_}) {
  32           $NearPage{$_} = $_;
  33           $NearSite{$_} = $site;
  34         }
  35       }
  36     }
  37   }
  38 }
  39
  40 sub NewResolveId {
  41   my $id = shift;
  42   my @result = OldResolveId($id);
  43   return @result if $result[1];
  44   NearInit();
  45   if ($NearPage{$id}) {
  46     $NearLinksUsed{$NearPage{$id}} = 1 ;
  47     return ('near', $NearPage{$id}, $NearSite{$id});
  48   }
  49 }
  50
  51 my $MyFootnoteCounter = 0;
  52 my @MyFootnotes = ();
  53
  54 sub MyRules {
  55   if ((-f GetLockedPageFile($OpenPageName))
  56       and (/\G(\&lt;form.*?\&lt;\/form\&gt;)/sgc)) {
  57     return UnquoteHtml($1);
  58   } elsif (/\G(Page alias: $LinkPattern)\n/gc
  59            or /\G(PageAlias: $FreeLinkPattern)\n/gc) {
  60     Dirty($1);
  61     print GetPageLink('PageAlias', 'Page alias')
  62       . ': ' . GetPermanentAnchor($2);
  63   } elsif (m/\G(\[\[\[(.*?)\]\]\])/gcs) {
  64     Dirty($1);
  65     push(@MyFootnotes,$2);
  66     $MyFootnoteCounter++;
  67     print $q->a({-href=>'#'.$MyFootnoteCounter,
  68                  -name=>'f'.$MyFootnoteCounter,
  69                  -title=>$2,
  70                  -class=>'footnote'},
  71                 $MyFootnoteCounter);
  72   } elsif (m/\G!\+\+\+/gc) {
  73     return '+++';
  74   } elsif (m/\Gportrait:$UrlPattern/gc) {
  75     return $q->img({-src=>$1, -alt=>T("Portrait"), -class=>'portrait'});
  76   } elsif (m/\GMy\s+subscribed\s+pages:\s*((?:(?:$LinkPattern|\[\[$FreeLinkPattern\]\]),\s*)+)categories:\s*((?:(?:$LinkPattern|\[\[$FreeLinkPattern\]\]),\s*)*(?:$LinkPattern|\[\[$FreeLinkPattern\]\]))/gc) {
  77     return Subscribe($1, $4);
  78   } elsif (m/\GMy\s+subscribed\s+pages:\s*((?:(?:$LinkPattern|\[\[$FreeLinkPattern\]\]),\s*)*(?:$LinkPattern|\[\[$FreeLinkPattern\]\]))/gc) {
  79     return Subscribe($1, '');
  80   } elsif (m/\GMy\s+subscribed\s+categories:\s*((?:(?:$LinkPattern|\[\[$FreeLinkPattern\]\]),\s*)*(?:$LinkPattern|\[\[$FreeLinkPattern\]\]))/gc) {
  81     return Subscribe('', $1);
  82   }
  83   return '';
  84 }
  85
  86 sub Subscribe {
  87   my ($pages, $categories) = @_;
  88   my $oldpos = pos;
  89   my @pageslist = map {
  90     if (/\[\[$FreeLinkPattern\]\]/) {
  91       FreeToNormal($1);
  92     } else {
  93       $_;
  94     }
  95   } split(/\s*,\s*/, $pages);
  96   my @catlist = map {
  97     if (/\[\[$FreeLinkPattern\]\]/) {
  98       FreeToNormal($1);
  99     } else {
 100       $_;
 101     }
 102   } split(/\s*,\s*/, $categories);
 103   my $regexp;
 104   $regexp .= '^(' . join('|', @pageslist) . ")\$" if @pageslist;
 105   $regexp .= '|' if @pageslist and @catlist;
 106   $regexp .= '(' . join('|', @catlist) . ')' if @catlist;
 107   pos = $oldpos;
 108   my $html = 'My subscribed ';
 109   return $html unless @pageslist or @catlist;
 110   $html .= 'pages: ' . join(', ', map { s/_/ /g; $_; } @pageslist)
 111     if @pageslist;
 112   $html .= ', ' if @pageslist and @catlist;
 113   $html .= 'categories: ' . join(', ', map { s/_/ /g; $_; } @catlist)
 114     if @catlist;
 115   return ScriptLink('action=rc;rcfilteronly=' . $regexp, $html);
 116 }
 117
 118 *OldPrintFooter = *PrintFooter;
 119 *PrintFooter = *NewPrintFooter;
 120
 121 sub NewPrintFooter {
 122   my @params = @_;
 123   my $html;
 124   if ($MyFootnoteCounter) {
 125     for (my $i = 1; $i <= $MyFootnoteCounter; $i++) {
 126       $html .= '<br>' if $html;
 127       $html .= $q->a({-name=>$i,
 128                       -href=>'#f'.$i},
 129                      $i . '.' ) . ' ' . shift @MyFootnotes;
 130     }
 131     print $q->div({-class=>'footnotes'},
 132                   $q->hr(), $q->p(T('Footnotes:')), $q->p($html));
 133   }
 134   OldPrintFooter(@params);
 135 }
 136
 137
 138 sub PrintMyContent {
 139   my $id = (shift);
 140   NearInit();
 141   if ($NearPage{$id}) {
 142     print $q->div({-class=>'sister'}, $q->hr(),
 143                   $q->p(T('The same page on other sites:'), $q->br(),
 144                         $q->a({-href=>GetSiteUrl($NearSite{$id}) . $id,
 145                                -title=>$NearSite{$id} . ':' . $id},
 146                               $q->img({-src=>'/community/'
 147                                        . $NearSite{$id} . '.png',
 148                                        -alt=>T('SisterSite:') . ' '
 149                                        . $NearSite{$id} . ':' . $id}))));
 150   }
 151   if (%NearLinksUsed) {
 152     print $q->div({-class=>'near'}, $q->p(GetPageLink(T('EditNearLinks')) . ':',
 153       join(' ', map { GetEditLink($_, $_); } keys %NearLinksUsed)));
 154   }
 155   if (GetParam('debug', 0)) {
 156     print $q->div({-class=>'debug'}, $q->hr(),
 157                   $q->p('Debug: ', ));
 158   }
 159 }
 160