Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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 contemplating the Monastery: (7)
As of 2014-08-30 17:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (293 votes), past polls