Changeset 230

Show
Ignore:
Timestamp:
04/12/07 18:08:26 (2 years ago)
Author:
ingy
Message:
 r3830@skinny-2:  ingy | 2007-04-09 10:03:17 +0800
 Make IO::All handle generic encodings.
Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/src/ingy/IO-All/Changes

    r225 r230  
     1--- 
     2version: 0.38 
     3date:    Mon Apr  9 10:52:44 JST 2007 
     4changes: 
     5- Add generic encoding, instead of just utf8. 
    16--- 
    27version: 0.37 

  • trunk/src/ingy/IO-All/MANIFEST

    r225 r230  
    4040t/devnull.t 
    4141t/empty.t 
     42t/encoding.t 
    4243t/error1.t 
    4344t/file_spec.t 
    …… 
    7980t/synopsis3.t 
    8081t/synopsis5.t 
     82t/text.big5 
     83t/text.utf8 
    8184t/tie.t 
    8285t/tie_file.t 

  • trunk/src/ingy/IO-All/META.yml

    r225 r230  
    55generated_by: hand 
    66distribution_type: module 
    7 version: 0.37 
     7version: 0.38 
    88name: IO-All 
    99author: Ingy döt Net <ingy@cpan.org> 

  • trunk/src/ingy/IO-All/README

    r225 r230  
    3232        $contents = io('file.txt')->utf8->all;      # Turn on utf8 
    3333        use IO::All -utf8;                          # Turn on utf8 for all io 
     34        $contents = io('file.txt')->all;            #   by default in this package. 
     35 
     36        # General Encoding Support 
     37        $contents = io('file.txt')->encoding('big5')->all; 
     38        use IO::All -encoding => 'big5';            # Turn on big5 for all io 
    3439        $contents = io('file.txt')->all;            #   by default in this package. 
    3540 
    …… 
    167172    You can also pass global flags like this: 
    168173 
    169         use IO::All -strict -utf8 -foobar; 
     174        use IO::All -strict -encoding => 'big5', -foobar; 
    170175 
    171176    Which automatically makes those method calls on every new IO object. In 
    …… 
    176181    becomes this: 
    177182 
    178         my $io = io('lalala.txt')->strict->utf8->foobar; 
     183        my $io = io('lalala.txt')->strict->encoding('big5')->foobar; 
    179184 
    180185METHOD ROLE CALL 
    …… 
    189194    "chdir", "chomp", "clear", "close", "confess", "content", "ctime", 
    190195    "curdir", "dbm", "deep", "device", "device_id", "devnull", "dir", 
    191     "domain", "empty", "eof", "errors", "file", "filename", "fileno", 
    192     "filepath", "filter", "fork", "from", "ftp", "get", "getc", "getline", 
    193     "getlines", "gid", "handle", "head", "http", "https", "inode", 
    194     "io_handle", "is_absolute", "is_dir", "is_dbm", "is_executable", 
    195     "is_file", "is_link", "is_mldbm", "is_open", "is_pipe", "is_readable", 
    196     "is_socket", "is_stdio", "is_string", "is_temp", "is_writable", "join", 
    197     "length", "link", "lock", "mailer", "mailto", "mkdir", "mkpath", 
    198     "mldbm", "mode", "modes", "mtime", "name", "new", "next", "nlink", 
    199     "open", "password", "path", "pathname", "perms", "pipe", "port", 
    200     "print", "printf", "println", "put", "rdonly", "rdwr", "read", 
    201     "readdir", "readlink", "recv", "rel2abs", "relative", "rename", 
     196    "domain", "empty", "encoding", "eof", "errors", "file", "filename", 
     197    "fileno", "filepath", "filter", "fork", "from", "ftp", "get", "getc", 
     198    "getline", "getlines", "gid", "handle", "head", "http", "https", 
     199    "inode", "io_handle", "is_absolute", "is_dir", "is_dbm", 
     200    "is_executable", "is_file", "is_link", "is_mldbm", "is_open", "is_pipe", 
     201    "is_readable", "is_socket", "is_stdio", "is_string", "is_temp", 
     202    "is_writable", "join", "length", "link", "lock", "mailer", "mailto", 
     203    "mkdir", "mkpath", "mldbm", "mode", "modes", "mtime", "name", "new", 
     204    "next", "nlink", "open", "password", "path", "pathname", "perms", 
     205    "pipe", "port", "print", "printf", "println", "put", "rdonly", "rdwr", 
     206    "read", "readdir", "readlink", "recv", "rel2abs", "relative", "rename", 
    202207    "request", "response", "rmdir", "rmtree", "rootdir", "scalar", "seek", 
    203208    "send", "separator", "shutdown", "size", "slurp", "socket", "sort", 
    …… 
    780785        Set the domain name or ip address that a socket should use. 
    781786 
     787    * encoding 
     788        Set the encoding to be used for the PerlIO layer. 
     789 
    782790    * errors 
    783791        Use this to set a subroutine reference that gets called when an 

  • trunk/src/ingy/IO-All/lib/IO/All.pm

    r225 r230  
    77sub Carp::carp; 
    88use IO::All::Base -base; 
    9 our $VERSION = '0.37'; 
     9our $VERSION = '0.38'; 
    1010use File::Spec(); 
    1111use Symbol(); 
    …… 
    360360field _binmode => undef; 
    361361field _strict => undef; 
     362field _encoding => undef; 
    362363field _utf8 => undef; 
    363364field _handle => undef; 
    …… 
    688689sub utf8 { 
    689690    my $self = shift; 
    690     return $self if $] < 5.008; 
     691    if ($] < 5.008) { 
     692        die "IO::All -utf8 not supported on Perl older than 5.8"; 
     693    } 
    691694    CORE::binmode($self->io_handle, ':utf8') 
    692695      if $self->is_open; 
    693696    $self->_utf8(1); 
     697    $self->encoding('utf8'); 
     698    return $self; 
     699} 
     700 
     701sub encoding { 
     702    my $self = shift; 
     703    my $encoding = shift 
     704      or die "No encoding value passed to IO::All::encoding"; 
     705    if ($] < 5.008) { 
     706        die "IO::All -encoding not supported on Perl older than 5.8"; 
     707    } 
     708    CORE::binmode($self->io_handle, ":$encoding") 
     709      if $self->is_open; 
     710    $self->_encoding($encoding); 
    694711    return $self; 
    695712} 
    …… 
    762779sub set_binmode { 
    763780    my $self = shift; 
    764     CORE::binmode($self->io_handle)  
    765       if $self->_binary; 
    766     CORE::binmode($self->io_handle, ":utf8") 
    767       if $self->_utf8; 
    768     CORE::binmode($self->io_handle, $self->_binmode) 
    769       if $self->_binmode; 
     781    if (my $encoding = $self->_encoding) { 
     782        CORE::binmode($self->io_handle, ":encoding($encoding)"); 
     783    } 
     784    elsif ($self->_binary) { 
     785        CORE::binmode($self->io_handle); 
     786    } 
     787    elsif ($self->_binmode) { 
     788        CORE::binmode($self->io_handle, $self->_binmode); 
     789    } 
    770790    return $self; 
    771791} 

  • trunk/src/ingy/IO-All/lib/IO/All.pod

    r225 r230  
    3434    $contents = io('file.txt')->utf8->all;      # Turn on utf8 
    3535    use IO::All -utf8;                          # Turn on utf8 for all io 
     36    $contents = io('file.txt')->all;            #   by default in this package. 
     37 
     38    # General Encoding Support 
     39    $contents = io('file.txt')->encoding('big5')->all; 
     40    use IO::All -encoding => 'big5';            # Turn on big5 for all io 
    3641    $contents = io('file.txt')->all;            #   by default in this package. 
    3742 
    …… 
    170175You can also pass global flags like this: 
    171176 
    172     use IO::All -strict -utf8 -foobar; 
     177    use IO::All -strict -encoding => 'big5', -foobar; 
    173178 
    174179Which automatically makes those method calls on every new IO object. In other 
    …… 
    179184becomes this: 
    180185 
    181     my $io = io('lalala.txt')->strict->utf8->foobar; 
     186    my $io = io('lalala.txt')->strict->encoding('big5')->foobar; 
    182187 
    183188=head1 METHOD ROLE CALL 
    …… 
    194199C<close>, C<confess>, C<content>, C<ctime>, C<curdir>, C<dbm>, C<deep>, 
    195200C<device>, C<device_id>, C<devnull>, C<dir>, C<domain>, C<empty>, 
    196 C<eof>, C<errors>, C<file>, C<filename>, C<fileno>, C<filepath>, 
    197 C<filter>, C<fork>, C<from>, C<ftp>, C<get>, C<getc>, C<getline>, 
    198 C<getlines>, C<gid>, C<handle>, C<head>, C<http>, C<https>, C<inode>, 
    199 C<io_handle>, C<is_absolute>, C<is_dir>, C<is_dbm>, C<is_executable>, 
    200 C<is_file>, C<is_link>, C<is_mldbm>, C<is_open>, C<is_pipe>, 
    201 C<is_readable>, C<is_socket>, C<is_stdio>, C<is_string>, C<is_temp>, 
    202 C<is_writable>, C<join>, C<length>, C<link>, C<lock>, C<mailer>, 
    203 C<mailto>, C<mkdir>, C<mkpath>, C<mldbm>, C<mode>, C<modes>, C<mtime>, 
    204 C<name>, C<new>, C<next>, C<nlink>, C<open>, C<password>, C<path>, 
    205 C<pathname>, C<perms>, C<pipe>, C<port>, C<print>, C<printf>, 
     201C<encoding>, C<eof>, C<errors>, C<file>, C<filename>, C<fileno>, 
     202C<filepath>, C<filter>, C<fork>, C<from>, C<ftp>, C<get>, C<getc>, 
     203C<getline>, C<getlines>, C<gid>, C<handle>, C<head>, C<http>, C<https>, 
     204C<inode>, C<io_handle>, C<is_absolute>, C<is_dir>, C<is_dbm>, 
     205C<is_executable>, C<is_file>, C<is_link>, C<is_mldbm>, C<is_open>, 
     206C<is_pipe>, C<is_readable>, C<is_socket>, C<is_stdio>, C<is_string>, 
     207C<is_temp>, C<is_writable>, C<join>, C<length>, C<link>, C<lock>, 
     208C<mailer>, C<mailto>, C<mkdir>, C<mkpath>, C<mldbm>, C<mode>, C<modes>, 
     209C<mtime>, C<name>, C<new>, C<next>, C<nlink>, C<open>, C<password>, 
     210C<path>, C<pathname>, C<perms>, C<pipe>, C<port>, C<print>, C<printf>, 
    206211C<println>, C<put>, C<rdonly>, C<rdwr>, C<read>, C<readdir>, 
    207212C<readlink>, C<recv>, C<rel2abs>, C<relative>, C<rename>, C<request>, 
    …… 
    848853Set the domain name or ip address that a socket should use. 
    849854 
     855=item * encoding 
     856 
     857Set the encoding to be used for the PerlIO layer. 
     858 
    850859=item * errors 
    851860 

  • trunk/src/ingy/IO-All/lib/IO/All/Base.pm

    r225 r230  
    2929sub generate_constructor { 
    3030    my $class = shift; 
    31     my @flags = grep { s/^-// } @_; 
     31    my (@flags, %flags, $key); 
     32    for (@_) { 
     33        if (s/^-//) { 
     34            push @flags, $_; 
     35            $flags{$_} = 1; 
     36            $key = $_; 
     37        } 
     38        else { 
     39            $flags{$key} = $_ if $key; 
     40        } 
     41    } 
    3242    my $constructor; 
    3343    $constructor = sub { 
    3444        my $self = $class->new(@_); 
    35         for my $flag (@flags) { 
    36             $self->$flag; 
     45        for (@flags) { 
     46            $self->$_($flags{$_}); 
    3747        } 
    3848        $self->constructor($constructor);