Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

shmem's scratchpad

by shmem (Canon)
on Mar 09, 2006 at 10:35 UTC ( #535366=scratchpad: print w/ replies, xml ) Need Help??

For Lady_Aleena - well, didn't know about choroba's scratchpad which contains the same stuff with minimal style changes
use strict; use warnings; my $element = pop; # 'something'; my @attributes; my %eq = ( script => ['defer'], label => ['for'], area => ['nohref'], head => ['profile'], option => ['selected'], param => ['valuetype'], table => ['border','cellpadding','cellspacing','frame','rules', +'summary'], object => ['archive','classid','codebase','codetype','data','dec +lare','standby'], select => ['multiple'], input => ['checked','maxlength'], frame => ['noresize'], a => [qw(onblur onfocus )], label => [qw(onblur onfocus )], area => [qw(onblur onfocus )], button => [qw(onblur onfocus )], select => [qw(onblur onfocus onchange multiple size + )], input => [qw(onblur onfocus onchange size onselect rea +donly checked maxlength )], textarea => [qw(onblur onfocus onchange onselect rea +donly )], iframe => ['frameborder','longdesc','marginheight','marginwidth' +,'scrolling'], frame => ['frameborder','longdesc','marginheight','marginwidth' +,'scrolling','noresize'], ); my %matches = ( '(?:meta)' => ['content' +,'http-equiv','scheme'], '^(?:body|frameset)$' => ['onload', +'onunload'], '^(?:a|area)$' => ['coords', +'shape'], '^(?:a|link)$' => ['hreflang +','rel','rev'], '(?:a|area|base|link)' => ['href'], '(?:a|area|base|link|form)' => ['target'] +, '(?:a|area|button|input|label|legend|textarea)' => ['accesske +y'], '(?:a|area|button|input|object|select|textarea)' => ['tabindex +'], '(?:a|link|script)' => ['charset' +], '(?:a|link|button|input|object|param|script|style)' => ['type'], '^(?:del|ins)$' => ['cite','d +atetime'], '^(?:col|colgroup|tbody|td|tfoot|th|thead|tr)$' => ['align',' +char','charoff','valign'], '^(?:td|th)$' => ['abbr','a +xis','colspan','headers','rowspan','scope'], '(?:col|colgroup)' => ['span'], '^(?:input|select)$' => ['size'], '^(?:form|input)$' => ['accept'] +, '^(?:image|area|input)$' => ['alt'], '^(?:button|input|optgroup|option|select|textarea)$' => ['disabled +'], '^(?:iframe|img|object)$' => ['height'] +, '^(?:img|input)$' => ['ismap'], '^(?:option|optgroup:)$' => ['label'], '^(?:style|link|form)$' => ['media'], '^(?:a|button|form|frame|iframe|img|input|object|map|param|meta|se +lect|textarea)$' => ['name'], '^(?:input|frame|iframe|img|script)$' => ['src'], '^(?:img|input|object)$' => ['usemap'] +, '^(?:input|option|param|button|li)$' => ['value'], '^(?:iframe|img|object|table|col|colgroup)$' => ['width'], ); my %non_matches = ( '^(?:base|basefont|head|html|meta|param|script|title|style)$' + => ['class','style'], '^(?:applet|base|basefont|bdo|br|frame|iframe|frameset|param|scrip +t)$' => ['dir'], '^(?:base|head|html|meta|script|style|title)$' + => ['id'], '^(?:applet|base|basefont|br|frame|frameset|iframe|param|script)$' + => ['lang'], '^(?:base|basefont|head|html|meta|param|script|title)$' + => ['title'], '^(?:applet|base|basefont|bdo|br|font|frame|frameset|head|html|ifr +ame|isindex|meta|param|script|style|title)$' => ['onclick','ondblclick','onkeydown','onkeypress','onkeyup', +'onmousedown', 'onmousemove','onmouseout','onmouseover','onmouseup' ], ); push @attributes, @{$eq{$element}} if exists $eq{$element}; $element =~ qr{$_} and push @attributes, @{$matches{$_}} for keys %mat +ches; $element !~ qr{$_} and push @attributes, @{$non_matches{$_}} for keys +%non_matches; print join("\n",sort @attributes);

foo.pl

#!/usr/bin/perl use strict; my $pat = shift; my $p; { my (%s, %i); my $d = my $c = 1; # our regexp will be inside parens, so first back +ref is 2 $p = join ( "", map { if($s{$_}++){ "\\".$i{$_} } else{ $i{$_}=++$c; $c>$d+1 ? '(?!'.join('|',map{"\\".abs}-$c+1..-$d-1).")(\\w)" : + "(\\w)"; } } split//,$pat ); } print '(',$p,")\n"; open my $fh, '<', shift; my %s; while (<$fh>) { my @l = (); while (/\b($p)\b/g) { push @l, $1 unless $s{$1}++; } print join (", ",@l), $/ if @l; }

try: perl foo.pl fusselkerl /usr/share/dict/words

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 having an uproarious good time at the Monastery: (15)
As of 2014-10-01 19:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    What is your favourite meta-syntactic variable name?














    Results (37 votes), past polls