Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
There's more than one way to do things
 
PerlMonks  

ikegami's scratchpad

by ikegami (Pope)
on Aug 16, 2004 at 23:32 UTC ( #383504=scratchpad: print w/ replies, xml ) Need Help??

Help for this page

Select Code to Download


  1. or download this
    Program received signal SIGSEGV, Segmentation fault.
    0x00000000004d406e in S_regmatch (prog=Cannot access memory at address
    + 0x3e4dd10ce38
    ...
    #6896 0x0000000000459750 in S_run_body (oldscope=1) at perl.c:2448
    #6897 0x0000000000459275 in perl_run (my_perl=0x792700) at perl.c:2368
    #6898 0x000000000041ff67 in main (argc=3, argv=0x3e4dd90b478, env=0x3e
    +4dd90b498) at perlmain.c:109
    
  2. or download this
    use IPC::Open3 qw( open3 );
    
    ...
    }
    
    waitpid($pid, 0);
    
  3. or download this
    use IPC::Open3 qw( open3 );
    
    ...
    }
    
    waitpid($pid, 0);
    
  4. or download this
    >type script.bat
    @echo off
    ...
    echo today=%today%
    for /f "usebackq delims=" %%q in (`perl -MPOSIX -E"say strftime('%Y%m%
    +d', localtime)"`) do set today=%%q
    echo today=%today%
    
  5. or download this
    perl -MDateTime -E"say DateTime->today( time_zone => 'local' )->ymd"
    
  6. or download this
    >type script.bat
    @echo off
    ...
    testb=
    testa=abc
    testb=def
    
  7. or download this
    package My::XML::Generator;
    
    ...
                ]),
            ]);
        }
    
  8. or download this
    #!/bin/bash
    exec 3>&2 2>&1
    err=$( perl -e'print "O\n"; warn "E\n"' 3>&2 2>&1 1>&3 )
    exec 2>&3 3>&-
    echo "[STDERR:$err]" >&2
    
  9. or download this
    $ x
    O
    ...
    
    $ x 1>/dev/null
    [STDERR:E]
    
  10. or download this
    # Set your timezone to America/New_York before running.
    # In this time zone, DST ends on Nov 2, 2008 at 2:00 AM.
    ...
    use POSIX;
    print( strftime( "%m-%d\n", localtime( 86400 * $_ + $time ) ) )
       for 1..30;
    
  11. or download this
    10-29
    10-30
    ...
    11-25
    11-26
           > 11-27 didn't get created
    
  12. or download this
       +-------------+    +-------------+    +-------------+
       | Document    |    | Linkage     |    | Animal      |
    ...
       +-------------+    +-------------+    +-------------+
    
    P - Primary key (Unique, Not NULL)
    
  13. or download this
    SELECT Document.data
      FROM Document
    ...
                   ON Animal.id = Linkage.b
                WHERE Animal.name IN (?, ?, ...)
           )
    
  14. or download this
    SELECT Document.data
      FROM Document
    ...
                GROUP BY Linkage.a
                HAVING COUNT(*) = ?
           )
    
  15. or download this
    use IO::Handle ();  # For "flush" method.
    
    ...
    }
    
    print("crlf\n");
    
  16. or download this
    use IO::Handle ();  # For "flush" method.
    
    ...
    STDOUT_BIN->flush();     
    
    print("crlf\n");
    
  17. or download this
    >perl -v
    
    ...
    -D100 L10
    0B27:0100  63 72 6C 66 0D 0A 72 61-77 0A 63 72 6C 66 0D 0A   crlf..raw
    +.crlf..
    -Q
    
  18. or download this
    use strict;
    use warnings;
    ...
    
    for (         $min .. $max) { print(":"); <STDIN>; last; }  # 2.2MB
    for ( reverse $min .. $max) { print(":"); <STDIN>; last; }  # 239MB
    
  19. or download this
    use File::Basename  qw( fileparse );
    use IO::Dir         qw( );
    ...
    
       return "$d${n}[$max]$e";
    }
    
  20. or download this
    sub get_iter {
       my $pass = 0;
    ...
    while ($_ = $i->()) {
       print("$_\n");
    }
    
  21. or download this
    sub get_iter {
       my $pass = 0;
    ...
    while ($_ = $i->()) {
       print("$_\n");
    }
    
  22. or download this
    sub get_fibonacci_iter {
       my ($x, $y) = (0, 1);
    ...
    my $i = get_fibonacci_iter();
    print($i->(), "\n")
       for 1..40;
    
  23. or download this
    my $mask = 0x06000003; # or whatever
    
    ...
       last if not $val;
       $val = ($val - 1) & $mask;
    }
    
  24. or download this
    0x00000000
    0x00000001
    ...
    0x06000001
    0x06000002
    0x06000003
    
  25. or download this
    sub slice_ref {
       return \@_;
    ...
    print("After inserting into bar:\n");    # Doesn't work:
    print('foo: ', join(', ', @foo), "\n");  # foo: a, 2, 3, 4, 5
    print('bar: ', join(', ', @bar), "\n");  # bar: a, 6, 2, 3
    
  26. or download this
    perl -M"ActivePerl::DocTools"
         -e"ActivePerl::DocTools::UpdateHTML();
            ActivePerl::DocTools::WriteTOC();"
    
  27. or download this
    use URI ();
    use File::Spec::Unix ();
    ...
    # ------
    # http://www.faqs.org/rfcs/
    # http://www.server.com/
    
  28. or download this
    system("... ...")
    system("...", "...", "...")
    ...
    IPC::Open3
    IPC::Run
    IPC::Run3
    
  29. or download this
    /^(?:(?!$re).)*$/          # NOT re
    /$re1|$re2/                # re1 OR re2
    /^(?=.*$re1)(?=.*$re2)/    # re1 AND re2
    
  30. or download this
    sub create_closure {
       my $var = shift;
    ...
    # around $var. I don't know if "closes"
    # is the official terminology, but
    # that's what's happening.
    
  31. or download this
    sub scale_dimentions {
       my ($width, $height, $max_width, $max_height) = @_;
    ...
    
    printf("%d,%d$/", scale_dimentions(2272, 1704, 150, 150));  # 150,112
    printf("%d,%d$/", scale_dimentions(1704, 2272, 150, 150));  # 112,150
    
  32. or download this
    my @ranges = (
       [ 0 .. 2 ],
    ...
    
    print(join(' ', @$_), $/)
       foreach @results;
    
  33. or download this
    my @lists = (
       [ ... ],
    ...
    
    print(join(' ', @$_), $/)
       foreach @results;
    
  34. or download this
    # Add $value to sorted @array, if it's not already there.
    my $idx = binsearch { $a <=> $b } $value, @array;
    splice(@array, ~$idx, 0, $value) if $idx < 0;
    
  35. or download this
    sub binsearch(&$\@) {
       my  $compare = $_[0];
    ...
    }
    
    sub _unsigned_to_signed { unpack('j', pack('J', $_[0])) }
    
  36. or download this
    $i = 4;       print($i)   while ($i--);  #  3210
    $i = 4;  do { print($i) } while ($i--);  # 43210
    
  37. or download this
    $a = something;  # something is executed in a scalar context.
    @a = something;  # something is executed in a list   context.
    ...
       print(scalar(localtime));  # Fri Oct  1 15:05:32 2004
    }
    # Refer to wantarray in perlfunc.
    
  38. or download this
    sub nearest {
       my ($num) = @_;
    ...
    
       return int($num + 0.5) * $f;
    }
    
  39. or download this
    sub nearest {
       my ($num, $digits) = @_;
    ...
    
       return int($num + 0.5) * $f;
    }
    
  40. or download this
    $stmt = 'SELECT Field1, Field2 FROM Table';
    $href = { map { @$_ } @{$dbh->selectall_arrayref($stmt)} };
    ...
    #    Row2Field1 => Row2Field2,
    #    ...
    # };
    
  41. or download this
    $stmt = 'SELECT Field1, Field2 FROM Table';
    $href = $dbh->selectall_hashref($stmt, 'Field1');
    ...
    #    Row2Field1 => { Field1 => Row2Field1, Field2 => Row2Field2 },
    #    ...
    # };
    
  42. or download this
    # Serializes an array, a hash or a list which contains only
    # strings and undefs. Everything else will be stringified.
    ...
          )
       } split(/\|/, $_[0]);
    }
    
  43. or download this
    # Untested.
    
    ...
    # End HTML.
    print($q->end_form());
    print($q->end_html());
    
  44. or download this
    sub flush {
       my $h = select($_[0]); my $af=$|; $|=1; $|=$af; select($h);
    }
    
  45. or download this
    package MyStruct;
    
    ...
       $x->Counter++;                      print($x->Counter, "\n");  # 5
       $x->Counter += 1;                   print($x->Counter, "\n");  # 6
    }
    
  46. or download this
    # This \$var syntax of open() requires Perl 5.8.0 or higher.
    use 5.8.0;
    ...
    }
    
    print("\$output contains:\n$output");
    
  47. or download this
    Windows Registry Editor Version 5.00
    
    ...
    
    [HKEY_CLASSES_ROOT\Drive\shell\cmd\command]
    @="cmd.exe /k \"cd %L\""
    
  48. or download this
    use strict;
    use warnings;
    ...
    test 3: bypassed
    test 4: bypassed
    test 5: bypassed
    
  49. or download this
    @status = sort {
       my $mtime_a = (stat("$target_dir\\$a"))[9];
       my $mtime_b = (stat("$target_dir\\$b"))[9];
       $mtime_a <=> $mtime_b
    } @status;
    
  50. or download this
    @status = (
       map  { $_->[0] }
    ...
       map  { [ $_, stat("$target_dir\\$_"))[9] ] }
       @status
    );
    
  51. or download this
    use Alorithm::Loops;
    
    ...
       ];
    }
    
  52. or download this
    use strict;
    use warnings;
    ...
    my $a = $p->[0];    ## Gives no warnings!!
    my $q = undef;
    my $b = ${$q}[0];   ## Gives no warnings!!
    
  53. or download this
    ...
    print("$p\n");  # ARRAY(0x1abefa0)
    print("$q\n");  # ARRAY(0x1abf054)
    
  54. or download this
    # Create some subroutines to find:
    sub PACKAGEA::PACKAGEB::test {}
    ...
    
    print(join(', ', check_for_sub('test')), $/);
    # Prints "main, PACKAGEA::PACKAGEB, PACKAGED"
    
  55. or download this
    # Create some packages for testing:
    $PACKAGEA::ANYVAR = 1;
    ...
    PACKAGEA exists
    PACKAGEA::PACKAGEB exists
    PACKAGEC doesn't exist
    
  56. or download this
    # Create some packages for testing:
    $PACKAGEA::ANYVAR = 1;
    ...
    IO
    CORE
    main
    
  57. or download this
    $color = substr($color, -6);
    $color .= '0' x length(6-$color);
    $color =~ s/[^0-9A-Fa-f]/0/g;
    $color = hex($color);
    
  58. or download this
    // K&R C:
    char string[6] = "hello";  // Initializes string[] to "hello\0".
    ...
    
    a1 = "Greetings";  // ERROR
    a2 = "Greetings";  // OK
    

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 making s'mores by the fire in the courtyard of the Monastery: (8)
As of 2014-04-17 05:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (440 votes), past polls