Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl use strict; use warnings; =head1 NAME linkextor -- extract particular links from HTML documents =head1 SYNOPSIS F<linkextor> S<B<[ -b baseurl ]>> S<B<[ -f filter ]>> S<B<[ files and urls ]>> =head1 DESCRIPTION C<linkextor> prints links found in given HTML documents, filtered by a +ny given expressions. If no files are specified on the command line, +the input document is read from STDIN. You can specify URLs on the co +mmand line; they will be downloaded and parsed transparently. By default, no links are filtered, so the output will include referenc +es to every external resource found in the file such as stylesheets, +external scripts, images, other documents, etc. After considering criteria, all matching links will be printed to STDO +UT. You could pipe them to C<wget -i -> to mass download them, or to +C<while read url ; do ... ; done> or C<xargs> to process them further +, or do anything else you can do with a list of links. =head1 ARGUMENTS =over 4 =item B<-h>, B<--help> See a synopsis. =item B<--man> Browse the manpage. =back =head1 OPTIONS =over 4 =item B<-b>, B<--base> Sets base URL to use for relative links in the file(s). This only applies to local files and input read from STDIN. When parsi +ng documents retrieved from a URL, the source URL is always the base +URL assumed for that document. =item B<-f>, B<--filter> Defines a filter. If no filter has been specified, B<all> external links will be returne +d. This includes links to CSS and Javascript files specified in C<E<l +t>linkE<gt>> elements, image links specified in C<E<lt>imgE<gt>> elem +ents, and so on. If one or more filters have been specified, only links conforming to a +ny of the specified criteria will be output. Filters take the form C<tagname:attribute:regex>. C<tagname> specifies + which tag this filter will allow. C<attribute> specifies which attri +bute of the allowed tags will be considered. C<regex> specifies a pat +tern which candidate links must match. You can leave any of the crite +ria empty. For empty criteria on the right-hand side of the specifica +tion, you can even omit the colon. Eg, C<-f 'a:href:\.mp3$'> will only extract links from the C<E<lt>href +E<gt>> attributes in the document's C<E<lt>aE<gt>> tags which end wit +h C<.mp3>. Since C<E<lt>aE<gt>> tags can only contain links in their +C<E<lt>hrefE<gt>> attribute you can shorten that to C<-f 'a::\.mp3$'> +. If you wanted any and all links from C<E<lt>aE<gt>> tags, you could + use C<-f a::>, where both the attribute and regex component are empt +y, or just C<-f a>: because both components to the right are empty, y +ou can leave out the colons entirely. Likewise, you could use C<-f im +g> to extract all images. =back =head1 BUGS None currently known. =head1 SEE ALSO =over 4 =item * L<perlre> =item * L<xargs(1)> =item * L<wget(1)> =back =head1 COPYRIGHT (c)2005 Aristotle Pagaltzis =head1 LICENCE This script is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. =cut use Getopt::Long; use Pod::Usage; use HTML::LinkExtor; use URI; use LWP::Simple; my %filter; sub if_valid_link { my ( $tag, $attr, $value ) = @_; return $value if not %filter; my $attr_filter = $filter{ $tag } || $filter{ '' } || return; my $patterns = $attr_filter->{ $attr } || $attr_filter->{ '' } || +return; return $value if not @$patterns; return $value if grep $value =~ /$_/, @$patterns; return; } sub push_links { my ( $p, $base, $link ) = @_; $base = './' if not defined $base; for( $p->links ) { my $tag = shift @$_; my ( $attr, $value ); push @$link, if_valid_link( $tag, $attr, URI->new_abs( $value, + $base )->as_string ) while ( $attr, $value ) = splice @$_, 0, 2; } } GetOptions( 'h|help' => sub { pod2usage( -verbose => 1 ) }, 'man' => sub { pod2usage( -verbose => 2 ) }, "b|base=s" => ( \my $opt_base ), "f|filter=s" => ( \my @opt_filter ), ) or pod2usage(); for( @opt_filter ) { my ( $tag, $attr, $pattern ) = split m!:!, $_, 3; $attr = '' unless defined $attr; push @{ $filter{ $tag }{ $attr } }, defined( $pattern ) ? qr/$patt +ern/ : (); } my $p = HTML::LinkExtor->new(); my @link; if ( @ARGV ) { for( @ARGV ) { if( -r ) { $p->parse_file( $_ ) or warn( "Couldn't parse $_\n" ), next; push_links( $p, $opt_base, \@link ); } else { ( my $html = get $_ ) or warn( "Could neither open nor download $_\n" ), nex +t; $p->parse( $html ) or warn( "Couldn't parse $_\n" ), next; push_links( $p, $_, \@link ); } } } else { $p->parse_file( \*STDIN ); push_links( $p, $opt_base, \@link ); } { local $\ = local $, = "\n"; print @link; }

In reply to linkextor extract particular links from HTML documents by Aristotle

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others contemplating the Monastery: (4)
    As of 2020-10-31 19:53 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      My favourite web site is:












      Results (291 votes). Check out past polls.

      Notices?