orphaned.pl 2.0 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465
  1. #!/usr/bin/perl
  2. # Orphaned Pages for Oddmuse Wikis
  3. # Copyright (C) 2004 Alex Schroeder <alex@emacswiki.org>
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. # GNU General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the
  17. # Free Software Foundation, Inc.
  18. # 59 Temple Place, Suite 330
  19. # Boston, MA 02111-1307 USA
  20. use CGI qw/:standard/;
  21. use CGI::Carp qw(fatalsToBrowser);
  22. use LWP::UserAgent;
  23. if (not param('url')) {
  24. print header(),
  25. start_html('Orphaned Pages'),
  26. h1('Orphaned Pages'),
  27. p('$Id: orphaned.pl,v 1.2 2004/03/21 00:33:41 as Exp $'),
  28. p('Returns a list of orphaned pages based on a dot-file.'),
  29. start_form(-method=>'GET'),
  30. p('URL for dot-file: ', textfield('url'), br(),
  31. 'Example: http://www.emacswiki.org/cgi-bin/alex?action=links;raw=1'),
  32. p('URL for list of nodes: ', textfield('nodes'), br(),
  33. 'Example: http://www.emacswiki.org/cgi-bin/alex?action=index;raw=1'),
  34. p(submit()),
  35. end_form(),
  36. end_html();
  37. exit;
  38. }
  39. print header(-type=>'text/plain; charset=UTF-8');
  40. $ua = LWP::UserAgent->new;
  41. $request = HTTP::Request->new('GET', param('url'));
  42. $response = $ua->request($request);
  43. $data = $response->content;
  44. while ($data =~ m/"(.*?)" -> "(.*?)"/g) {
  45. $page{$1} = 1;
  46. $link{$2} = 1;
  47. }
  48. $request = HTTP::Request->new('GET', param('nodes'));
  49. $response = $ua->request($request);
  50. $data = $response->content;
  51. foreach $pg (split(/\n/, $data)) {
  52. $pg =~ s/_/ /g;
  53. $page{$pg} = 1 if $pg;
  54. }
  55. foreach $pg (sort keys %page) {
  56. print $pg, "\n" unless $link{$pg};
  57. }