File Coverage

blib/lib/D64/Disk/Image.pm
Criterion Covered Total %
statement 161 200 80.5
branch 7 26 26.9
condition 17 59 28.8
subroutine 37 42 88.1
pod 23 23 100.0
total 245 350 70.0


line stmt bran cond sub pod time code
1             package D64::Disk::Image;
2              
3             =head1 NAME
4              
5             D64::Disk::Image - Perl interface to Per Olofsson's "diskimage.c", an ANSI C library for manipulating Commodore disk images
6              
7             =head1 SYNOPSIS
8              
9             use D64::Disk::Image qw(:all);
10              
11             # Create an empty image:
12             my $d64 = D64::Disk::Image->create_image('image.d64');
13              
14             # Format the image:
15             my $rawname = $d64->rawname_from_name('title');
16             my $rawid = $d64->rawname_from_name('id');
17             $d64->format($rawname, $rawid);
18              
19             # Write the image to disk:
20             $d64->free_image();
21              
22             # Load an image from disk:
23             my $d64 = D64::Disk::Image->load_image('image.d64');
24              
25             # Open a file for writing:
26             my $rawname = $d64->rawname_from_name('filename');
27             my $prg = $d64->open($rawname, T_PRG, F_WRITE);
28              
29             # Write data to file:
30             my $counter = $prg->write($buffer);
31              
32             # Close a file:
33             $prg->close();
34              
35             # Open a file for reading:
36             my $rawname = $d64->rawname_from_name('filename');
37             my $prg = $d64->open($rawname, T_PRG, F_READ);
38              
39             # Read data from file:
40             my ($counter, $buffer) = $prg->read();
41              
42             # Close a file:
43             $prg->close();
44              
45             # Free an image in memory:
46             $d64->free_image();
47              
48             =head1 DESCRIPTION
49              
50             Per Olofsson's "diskimage.c" is an ANSI C library for manipulating Commodore disk images. In Perl the following operations are implemented via C package:
51              
52             =over
53              
54             =item *
55             Open file ('$' reads directory)
56              
57             =item *
58             Delete file
59              
60             =item *
61             Rename file
62              
63             =item *
64             Format disk
65              
66             =item *
67             Allocate sector
68              
69             =item *
70             Deallocate sector
71              
72             =back
73              
74             Additionally, the following operations are implemented via accompanying C package:
75              
76             =over
77              
78             =item *
79             Read file
80              
81             =item *
82             Write file
83              
84             =item *
85             Close file
86              
87             =back
88              
89             The following formats are supported:
90              
91             =over
92              
93             =item *
94             D64 (single-sided 1541 disk image, with optional error info, which is currently ignored)
95              
96             =item *
97             D71 (double-sided 1571 disk image)
98              
99             =item *
100             D81 (3,5" 1581 disk image, however only root directory)
101              
102             =back
103              
104             =head1 METHODS
105              
106             =cut
107              
108 4     4   331203 use bytes;
  4         90  
  4         21  
109 4     4   117 use strict;
  4         9  
  4         75  
110 4     4   18 use warnings;
  4         8  
  4         120  
111              
112             # Image type constants:
113 4     4   20 use constant D64 => 1;
  4         7  
  4         262  
114 4     4   23 use constant D71 => 2;
  4         9  
  4         157  
115 4     4   20 use constant D81 => 3;
  4         8  
  4         154  
116              
117             # Image size constants:
118 4     4   21 use constant D64_SIZE => 174848;
  4         8  
  4         171  
119 4     4   22 use constant D71_SIZE => 349696;
  4         7  
  4         228  
120 4     4   28 use constant D81_SIZE => 819200;
  4         8  
  4         186  
121              
122             # File type constants:
123 4     4   39 use constant T_DEL => 0;
  4         9  
  4         187  
124 4     4   23 use constant T_SEQ => 1;
  4         13  
  4         186  
125 4     4   23 use constant T_PRG => 2;
  4         8  
  4         164  
126 4     4   21 use constant T_USR => 3;
  4         8  
  4         177  
127 4     4   22 use constant T_REL => 4;
  4         23  
  4         212  
128 4     4   23 use constant T_CBM => 5;
  4         7  
  4         170  
129 4     4   21 use constant T_DIR => 6;
  4         7  
  4         302  
130              
131             our $VERSION = '0.03';
132              
133 4     4   26 use Carp qw/carp croak verbose/;
  4         11  
  4         682  
134              
135             require XSLoader;
136             XSLoader::load(__PACKAGE__, $VERSION);
137              
138 4     4   1872 use D64::Disk::Image::File qw(:all);
  4         9  
  4         520  
139              
140 4     4   27 use base qw( Exporter );
  4         6  
  4         7327  
141             our %EXPORT_TAGS = ();
142             $EXPORT_TAGS{'imagetypes'} = [ qw(&D64 &D71 &D81) ];
143             $EXPORT_TAGS{'filetypes'} = [ qw(&T_DEL &T_SEQ &T_PRG &T_USR &T_REL &T_CBM &T_DIR) ];
144             $EXPORT_TAGS{'modes'} = [ qw(&F_READ &F_WRITE) ];
145             $EXPORT_TAGS{'types'} = [ @{$EXPORT_TAGS{'imagetypes'}}, @{$EXPORT_TAGS{'filetypes'}} ];
146             $EXPORT_TAGS{'all'} = [ @{$EXPORT_TAGS{'types'}}, @{$EXPORT_TAGS{'modes'}} ];
147             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
148             our @EXPORT = qw();
149              
150             =head2 new / load_image
151              
152             Create new C object and load existing D64/D71/D81 image file from disk:
153              
154             my $d64DiskImageObj = D64::Disk::Image->new($name);
155             my $d64DiskImageObj = D64::Disk::Image->load_image($name);
156              
157             =head2 new / create_image
158              
159             Create new C object and create new D64/D71/D81 image file on disk:
160              
161             my $d64DiskImageObj = D64::Disk::Image->new($name, $imageType);
162             my $d64DiskImageObj = D64::Disk::Image->create_image($name, $imageType);
163              
164             The following image type constants are available: D64, D71, D81 (image type D64 is used by default when executed as "create_image"). Each disk created needs to be formatted first before it can be used.
165              
166             =cut
167              
168             sub new {
169 0     0 1 0 my $this = shift;
170 0         0 my $name = shift;
171 0         0 my $imageType = shift;
172 0 0       0 unless (defined $imageType) {
173 0         0 my $self = $this->load_image($name);
174 0         0 return $self;
175             }
176             else {
177 0         0 my $self = $this->create_image($name, $imageType);
178 0         0 return $self;
179             }
180             }
181              
182             sub load_image {
183 1     1 1 11 my $this = shift;
184 1         2 my $name = shift;
185 1 50 33     32 croak "Failed to open '${name}': file does not exist" unless defined $name and -e $name and -r $name;
      33        
186 1   33     8 my $class = ref($this) || $this;
187 1         3 my $self = {};
188 1         3 bless $self, $class;
189 1         79 my $diskImage = di_load_image($name);
190 1         6 $self->{'DISK_IMAGE'} = $diskImage;
191 1         4 return $self;
192             }
193              
194             sub create_image {
195 28     28 1 8940 my $this = shift;
196 28         53 my $name = shift;
197 28 50 33     755 croak "Failed to create disk image file '${name}': file already exists" if defined $name and -e $name;
198 28   33     102 my $imageType = shift || &D64;
199 28   33     95 my $class = ref($this) || $this;
200 28         211 my $sizeMap_ref = {
201             &D64 => &D64_SIZE,
202             &D71 => &D71_SIZE,
203             &D81 => &D81_SIZE,
204             };
205 28         69 my $size = $sizeMap_ref->{$imageType};
206 28         41 my $self = {};
207 28         57 bless $self, $class;
208 28         1449 my $diskImage = di_create_image($name, $size);
209 28         101 $self->{'DISK_IMAGE'} = $diskImage;
210 28         154 return $self;
211             }
212              
213             =head2 free_image
214              
215             Free an image in memory (each opened disk needs to be subsequently freed to avoid memory leaks):
216              
217             $d64DiskImageObj->free_image();
218              
219             If the image has been modified, the changes will be written to disk.
220              
221             =cut
222              
223             sub free_image {
224 29     29 1 13997 my $self = shift;
225 29         49 my $diskImage = $self->{'DISK_IMAGE'};
226 29         5407 di_free_image($diskImage);
227             }
228              
229             =head2 sync
230              
231             Write the image to disk:
232              
233             $d64DiskImageObj->sync();
234              
235             =cut
236              
237             sub sync {
238 1     1 1 7 my $self = shift;
239 1         4 my $diskImage = $self->{'DISK_IMAGE'};
240 1         183 di_sync($diskImage);
241             }
242              
243             =head2 status
244              
245             Get the drive status:
246              
247             my ($numstatus, $status) = $d64DiskImageObj->status();
248              
249             Numerical status is returned first, textual content of a status message is copied to the second return value.
250              
251             =cut
252              
253             sub status {
254 3     3 1 18 my $self = shift;
255 3         6 my $diskImage = $self->{'DISK_IMAGE'};
256 3         35 my ($numstatus, $status) = di_status($diskImage);
257 3 50 33     23 carp "Failed to read disk image status" unless defined $status and length $status > 0;
258 3         12 return ($numstatus, $status);
259             }
260              
261             =head2 open
262              
263             Open a file for reading or writing:
264              
265             my $imageFileObj = $d64DiskImageObj->open($rawname, $fileType, $mode);
266              
267             The following file type constants are available: T_DEL, T_SEQ, T_PRG, T_USR, T_REL, T_CBM, T_DIR (by default file type T_PRG is used)
268              
269             There are two open modes available: F_READ for reading, F_WRITE for writing (by default file is opened in F_READ mode)
270              
271             Opening, reading, writing, and closing files is described in detail in L
272              
273             =cut
274              
275             sub open {
276 19     19 1 73 my $self = shift;
277 19         29 my $rawname = shift;
278 19   33     39 my $fileType = shift || &T_PRG;
279 19   33     31 my $mode = shift || &F_READ;
280 19         31 my $diskImage = $self->{'DISK_IMAGE'};
281 19         53 my $imageFile = D64::Disk::Image::File->open($diskImage, $rawname, $fileType, $mode);
282 16         49 return $imageFile;
283             }
284              
285             =head2 format
286              
287             Format the image:
288              
289             my $numstatus = $d64DiskImageObj->format($rawname, $rawid);
290              
291             If $rawid is given, a full format is performed.
292              
293             my $numstatus = $d64DiskImageObj->format($rawname);
294              
295             If no $rawid is given, a quick format is performed.
296              
297             =cut
298              
299             sub format {
300 23     23 1 91 my $self = shift;
301 23         36 my $rawname = shift;
302 23   100     57 my $rawid = shift || '\0';
303 23         41 my $diskImage = $self->{'DISK_IMAGE'};
304 23         961 my $numstatus = di_format($diskImage, $rawname, $rawid);
305 23         62 return $numstatus;
306             }
307              
308             =head2 delete
309              
310             Delete files matching the pattern:
311              
312             my $numstatus = $d64DiskImageObj->delete($rawPattern, $fileType);
313              
314             =cut
315              
316             sub delete {
317 1     1 1 6 my $self = shift;
318 1         2 my $rawPattern = shift;
319 1   33     4 my $fileType = shift || &T_PRG;
320 1         2 my $diskImage = $self->{'DISK_IMAGE'};
321 1         5 my $status = di_delete($diskImage, $rawPattern, $fileType);
322 1         3 return $status;
323             }
324              
325             =head2 rename
326              
327             Rename a file:
328              
329             my $numstatus = $d64DiskImageObj->rename($oldRawName, $newRawName, $fileType);
330              
331             =cut
332              
333             sub rename {
334 2     2 1 13 my $self = shift;
335 2         4 my $oldRawName = shift;
336 2         2 my $newRawName = shift;
337 2   33     6 my $fileType = shift || &T_PRG;
338 2         4 my $diskImage = $self->{'DISK_IMAGE'};
339 2         7 my $status = di_rename($diskImage, $oldRawName, $newRawName, $fileType);
340 2         6 return $status;
341             }
342              
343             =head2 sectors_per_track
344              
345             Get the number of sectors in a given track:
346              
347             my $sectors = D64::Disk::Image->sectors_per_track($imageType, $track);
348             my $sectors = $d64DiskImageObj->sectors_per_track($imageType, $track);
349              
350             =cut
351              
352             sub sectors_per_track {
353 6     6 1 2669 my $this = shift;
354 6         12 my $imageType = shift;
355 6         8 my $track = shift;
356 6         17 my $sectors = di_sectors_per_track($imageType, $track);
357 6         16 return $sectors;
358             }
359              
360             =head2 tracks
361              
362             Get the number of tracks in the image:
363              
364             my $tracks = D64::Disk::Image->tracks($imageType);
365             my $tracks = $d64DiskImageObj->tracks($imageType);
366              
367             =cut
368              
369             sub tracks {
370 3     3 1 1413 my $this = shift;
371 3         7 my $imageType = shift;
372 3         10 my $tracks = di_tracks($imageType);
373 3         6 return $tracks;
374             }
375              
376             =head2 title
377              
378             Get the disk title and id in the BAM:
379              
380             my ($title, $id) = $d64DiskImageObj->title();
381              
382             =cut
383              
384             sub title {
385 2     2 1 13 my $self = shift;
386 2         5 my $diskImage = $self->{'DISK_IMAGE'};
387 2         13 my ($title, $id) = di_title($diskImage);
388 2 50 33     17 carp "Failed to read disk image title" unless defined $title and length $title > 0;
389 2 50 33     14 carp "Failed to read disk image id" unless defined $id and length $id > 0;
390 2         9 return ($title, $id);
391             }
392              
393             =head2 track_blocks_free
394              
395             Get the number of free sectors in a given track:
396              
397             my $track_blocks_free = $d64DiskImageObj->track_blocks_free($track);
398              
399             =cut
400              
401             sub track_blocks_free {
402 3     3 1 13 my $self = shift;
403 3         4 my $track = shift;
404 3         7 my $diskImage = $self->{'DISK_IMAGE'};
405 3         8 my $track_blocks_free = di_track_blocks_free($diskImage, $track);
406 3         7 return $track_blocks_free;
407             }
408              
409             =head2 is_ts_free
410              
411             Get non-zero if the given track and sector is free, and zero if it's allocated:
412              
413             my $is_ts_free = $d64DiskImageObj->is_ts_free($track, $sector);
414              
415             =cut
416              
417             sub is_ts_free {
418 3     3 1 23 my $self = shift;
419 3         5 my $track = shift;
420 3         5 my $sector = shift;
421 3         5 my $diskImage = $self->{'DISK_IMAGE'};
422 3         8 my $is_ts_free = di_is_ts_free($diskImage, $track, $sector);
423 3         8 return $is_ts_free;
424             }
425              
426             =head2 alloc_ts
427              
428             Allocate a given track and sector:
429              
430             $d64DiskImageObj->alloc_ts($track, $sector);
431              
432             =cut
433              
434             sub alloc_ts {
435 4     4 1 15 my $self = shift;
436 4         6 my $track = shift;
437 4         7 my $sector = shift;
438 4         5 my $diskImage = $self->{'DISK_IMAGE'};
439 4         13 di_alloc_ts($diskImage, $track, $sector);
440             }
441              
442             =head2 free_ts
443              
444             Free a given track and sector:
445              
446             $d64DiskImageObj->free_ts($track, $sector);
447              
448             =cut
449              
450             sub free_ts {
451 2     2 1 9 my $self = shift;
452 2         3 my $track = shift;
453 2         3 my $sector = shift;
454 2         17 my $diskImage = $self->{'DISK_IMAGE'};
455 2         7 di_free_ts($diskImage, $track, $sector);
456             }
457              
458             =head2 rawname_from_name
459              
460             Convert a NULL-terminated string to 16-byte 0xA0 padding:
461              
462             my $rawname = D64::Disk::Image->rawname_from_name($name);
463             my $rawname = $d64DiskImageObj->rawname_from_name($name);
464              
465             =cut
466              
467             sub rawname_from_name {
468 57     57 1 1076 my $this = shift;
469 57         85 my $name = shift;
470 57         174 my $rawname = di_rawname_from_name($name);
471 57 50 33     225 carp "Failed to convert '${name}' to rawname" unless defined $rawname and length $rawname > 0;
472 57         141 return $rawname;
473             }
474              
475             =head2 name_from_rawname
476              
477             Converts a 0xA0 padded string to a NULL-terminated string:
478              
479             my $name = D64::Disk::Image->name_from_rawname($rawname);
480             my $name = $d64DiskImageObj->name_from_rawname($rawname);
481              
482             =cut
483              
484             sub name_from_rawname {
485 25     25 1 1137 my $this = shift;
486 25         36 my $rawname = shift;
487 25         74 my $name = di_name_from_rawname($rawname);
488 25 50 33     116 carp "Failed to convert '${rawname}' to name" unless defined $name and length $name > 0;
489 25         71 return $name;
490             }
491              
492             =head2 blocksfree
493              
494             Get number of blocks free:
495              
496             my $blocksFree = $d64DiskImageObj->blocksfree();
497              
498             =cut
499              
500             sub blocksfree {
501 0     0 1   my $self = shift;
502 0           my $diskImage = $self->{'DISK_IMAGE'};
503 0           my $blocksFree = _di_blocksfree($diskImage);
504 0           return $blocksFree;
505             }
506              
507             =head2 type
508              
509             Get image type:
510              
511             my $imageType = $d64DiskImageObj->type();
512              
513             =cut
514              
515             sub type {
516 0     0 1   my $self = shift;
517 0           my $diskImage = $self->{'DISK_IMAGE'};
518 0           my $imageType = _di_type($diskImage);
519 0           return $imageType;
520             }
521              
522             =head2 ascii_to_petscii
523              
524             Convert an ASCII string to a PETSCII string:
525              
526             my $petscii_string = D64::Disk::Image->ascii_to_petscii($ascii_string);
527             my $petscii_string = $d64DiskImageObj->ascii_to_petscii($ascii_string);
528              
529             =cut
530              
531             sub ascii_to_petscii {
532 0     0 1   my $this = shift;
533 0           my $str_ascii = shift;
534 0           my $str_petscii = '';
535 0           while ($str_ascii =~ s/^(.)(.*)$/$2/) {
536 0           my $c = ord $1;
537 0           $c &= 0x7f;
538 0 0 0       if ($c >= ord 'A' && $c <= ord 'Z') {
    0 0        
539 0           $c += 32;
540             } elsif ($c >= ord 'a' && $c <= ord 'z') {
541 0           $c -= 32;
542             }
543 0           $str_petscii .= chr $c;
544             }
545 0           return $str_petscii;
546             }
547              
548             =head2 petscii_to_ascii
549              
550             Convert a PETSCII string to an ASCII string:
551              
552             my $ascii_string = D64::Disk::Image->petscii_to_ascii($petscii_string);
553             my $ascii_string = $d64DiskImageObj->petscii_to_ascii($petscii_string);
554              
555             =cut
556              
557             sub petscii_to_ascii {
558 0     0 1   my $this = shift;
559 0           my $str_petscii = shift;
560 0           my $str_ascii = '';
561 0           while ($str_petscii =~ s/^(.)(.*)$/$2/) {
562 0           my $c = ord $1;
563 0           $c &= 0x7f;
564 0 0 0       if ($c >= ord 'A' && $c <= ord 'Z') {
    0 0        
    0          
565 0           $c += 32;
566             } elsif ($c >= ord 'a' && $c <= ord 'z') {
567 0           $c -= 32;
568             } elsif ($c == 0x7f) {
569 0           $c = 0x3f;
570             }
571 0           $str_ascii .= chr $c;
572             }
573 0           return $str_ascii;
574             }
575              
576             =head1 EXAMPLES
577              
578             Print out the BAM:
579              
580             # Load image into RAM:
581             my $d64 = D64::Disk::Image->load_image('image.d64');
582              
583             # Get image type:
584             my $imageType = $d64->type();
585              
586             # Print BAM:
587             print "TRK FREE MAP\n";
588             for (my $track = 1; $track <= $d64->tracks($imageType); $track++) {
589             my $sectors = $d64->sectors_per_track($imageType, $track);
590             printf "%3d: %2d/%d ", $track, $d64->track_blocks_free($track), $sectors;
591             for (my $sector = 0; $sector < $sectors; $sector++) {
592             printf "%d", $d64->is_ts_free($track, $sector);
593             }
594             print "\n";
595             }
596             print "\n";
597              
598             # Print number of blocks free:
599             my $blocksFree = $d64->blocksfree();
600             printf "%d blocks free\n", $blocksFree;
601              
602             # Release image:
603             $d64->free_image();
604              
605             List the directory:
606              
607             my @file_types = qw/del seq prg usr rel cbm dir ???/;
608              
609             # Load image into RAM:
610             my $d64 = D64::Disk::Image->load_image('image.d64');
611              
612             # Open directory for reading:
613             my $dir = $d64->open('$', T_PRG, F_READ);
614              
615             # Convert title to ASCII:
616             my ($title, $id) = $d64->title();
617             $title = $d64->name_from_rawname($title);
618             $title = $d64->petscii_to_ascii($title);
619              
620             # Convert ID to ASCII:
621             $id = $d64->name_from_rawname($id);
622             $id = $d64->petscii_to_ascii($id);
623              
624             # Print title and disk ID:
625             printf "0 \"%-16s\" %s\n", $title, $id;
626              
627             # Read first block into buffer:
628             my ($counter, $buffer) = $dir->read(254);
629             die 'BAM read failed' if $counter != 254;
630              
631             # Read directory blocks:
632             while (1) {
633             my ($counter, $buffer) = $dir->read(254);
634             last unless $counter == 254;
635              
636             for (my $offset = -2; $offset < 254; $offset += 32) {
637              
638             # If file type != 0:
639             my $file_type = ord (substr $buffer, $offset + 2, 1);
640             if ($file_type != 0) {
641              
642             my $rawname = substr $buffer, $offset + 5;
643             my $name = $d64->name_from_rawname($rawname);
644             my $type = $file_type & 7;
645             my $closed = $file_type & 0x80;
646             my $locked = $file_type & 0x40;
647             my $size = ord (substr $buffer, $offset + 31, 1) << 8 | ord (substr $buffer, $offset + 30, 1);
648              
649             # Convert to ASCII and add quotes:
650             $name = $d64->petscii_to_ascii($name);
651             my $quotename = sprintf "\"%s\"", $name;
652              
653             # Print directory entry:
654             printf "%-4d %-18s%c%s%c\n", $size, $quotename, $closed ? ord ' ' : ord '*', $file_types[$type], $locked ? ord '<' : ord ' ';
655             }
656             }
657             }
658              
659             # Print number of blocks free:
660             my $blocksFree = $d64->blocksfree();
661             printf "%d blocks free\n", $blocksFree;
662              
663             # Close directory:
664             $dir->close();
665              
666             # Release image:
667             $d64->free_image();
668              
669             Copy a file from a disk image:
670              
671             # Load image into RAM:
672             my $d64 = D64::Disk::Image->load_image('image.d64');
673              
674             # Convert filename:
675             my $name = 'filename';
676             my $rawname = $d64->rawname_from_name($d64->ascii_to_petscii($name));
677              
678             # Open file for reading:
679             my $prg = $d64->open($rawname, T_PRG, F_READ);
680              
681             # Open file for writing:
682             die "$name file already exists" if -e $name;
683             open PRG, '>:bytes', $name or die "Couldn't open $name file for writing";
684              
685             # Read data from file:
686             my ($size, $buffer) = $prg->read();
687             print PRG $buffer;
688             printf "Read %d bytes from %s\n", $size, $disk;
689              
690             # Close files:
691             close PRG;
692             $prg->close();
693              
694             # Release image:
695             $d64->free_image();
696              
697             Copy a file to a disk image:
698              
699             # Load image into RAM:
700             my $d64 = D64::Disk::Image->load_image('image.d64');
701              
702             # Convert filename:
703             my $name = 'filename';
704             my $rawname = $d64->rawname_from_name($d64->ascii_to_petscii($name));
705              
706             # Open file for writing:
707             my $prg = $d64->open($rawname, T_PRG, F_WRITE);
708              
709             # Open file for reading:
710             die "$name file does not exist" unless -e $name;
711             open PRG, '<:bytes', $name or die "Couldn't open $name file for reading";
712              
713             # Write data to file:
714             my $buffer;
715             my $filesize = (stat($name))[7];
716             sysread PRG, $buffer, $filesize;
717             my $size = $prg->write($buffer);
718             printf "Wrote %d bytes to %s\n", $size, $disk_3;
719              
720             # Close files:
721             close PRG;
722             $prg->close();
723              
724             # Release image:
725             $d64->free_image();
726              
727             Create an empty disk image:
728              
729             # Create an empty image:
730             my $d64 = D64::Disk::Image->create_image('image.d64', D64);
731              
732             # Convert title:
733             my $name = 'title';
734             my $rawname = $d64->rawname_from_name($d64->ascii_to_petscii($name));
735              
736             # Convert ID:
737             my $id = 'id';
738             my $rawid = $d64->rawname_from_name($d64->ascii_to_petscii($id));
739              
740             # Format the image:
741             $d64->format($rawname, $rawid);
742              
743             # Release image:
744             $d64->free_image();
745              
746             =head1 BUGS
747              
748             There are no known bugs at the moment. Please report any bugs or feature requests.
749              
750             =head1 EXPORT
751              
752             C exports nothing by default.
753              
754             You may request the import of image type constants (D64, D71, and D81), and file type constants (C, C, C, C, C, C, and C). All of these constants can be explicitly imported from C by using it with ":types" tag. You may also request the import of open mode constants (C, and C). Both these constants can be explicitly imported from C by using it with ":modes" tag. All constants can be explicitly imported from C by using it with ":all" tag.
755              
756             =head1 SEE ALSO
757              
758             L
759              
760             =head1 AUTHOR
761              
762             Pawel Krol, Epawelkrol@cpan.orgE.
763              
764             =head1 VERSION
765              
766             Version 0.03 (2018-11-24)
767              
768             =head1 COPYRIGHT AND LICENSE
769              
770             diskimage.c is released under a slightly modified BSD license.
771              
772             Copyright (c) 2003-2006, Per Olofsson
773             All rights reserved.
774              
775             Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
776              
777             =over
778              
779             =item *
780              
781             Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
782              
783             =item *
784              
785             Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
786              
787             =back
788              
789             THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
790              
791             diskimage.c website: L
792              
793             =cut
794              
795             1;